surgery ;BMI/BI Surgery Prototype. ;09/27/2013
 Quit
 ;
list  ; Public
 New JQ,AQ,FFC,FFV,FILE,FIELD,AR,JR,START,END,INDEX,x
 ; JsonRequest        - JQ
 ; ArrayRequest       - AQ
 ; ArrayResults       - AR
 ; JsonResults        - JR
 ; File/Field Counter - FFC
 ; File/Field Value   - FFV
 ; File               - FILE
 ; Field              - FIELD
 ; FileMan Index      - INDEX
 Set JQ=$$ListSet()
 Do DECODE^XLFJSON("JQ","AQ")
 For FFC=1:1:$Order(AQ(""),-1) Do
 . Set FFV=AQ(FFC)
 . Set FILE=$Translate($Piece(FFV,"F",2),"P",".")
 . Set FIELD=$Translate($Piece(FFV,"F",3),"P",".")
 . ;
 . If $Piece(^DD(FILE,FIELD,0),"^",2)["S" Do
 .. Do SetOfCodes(FFV,FILE,FIELD,.AR)
 . ;
 . If $Piece(^DD(FILE,FIELD,0),"^",2)["D",$Data(AQ(FFC,"START")),$Data(AQ(FFC,"END")) Do
 .. Set START=AQ(FFC,"START")
 .. Set END=AQ(FFC,"END")
 .. Do DateList(FFV,START,END,.AR)
 . ;
 . If $Piece(^DD(FILE,FIELD,0),"^",2)["P",$Data(AQ(FFC,"INDEX")) Do
 .. Set INDEX=AQ(FFC,"INDEX")
 .. Do PointerList(FFV,FILE,FIELD,INDEX,.AR)
 ;
 Do ENCODE^XLFJSON("AR","JR")
 Set x=0 For  Set x=$Order(JR(x)) Quit:+x=0  Write JR(x)
 Quit
 ;
SetOfCodes(FFV,FILE,FIELD,AR)  ; Private
 New Selection,SelectionSet,SelectionCount
 ; Get the Set Of Codes
 Set SelectionSet=$Piece(^DD(FILE,FIELD,0),"^",3)
 For SelectionCount=1:1:$Length(SelectionSet,";") Do
 . Set Selection=$Piece(SelectionSet,";",SelectionCount)
 . Quit:Selection=""
 . Set AR(FFV,""""_$Piece(Selection,":",2),"INT")=$Piece(Selection,":",1)
 . Set AR(FFV,""""_$Piece(Selection,":",2),"EXT")=$Piece(Selection,":",2)
 Quit
 ;
DateList(FFV,START,END,AR)  ; Private
 New cnt
 ; Create the Date List
 For cnt=($H-START):1:($H+END) Do
 . Set AR(FFV,""""_$$HTFM^XLFDT(cnt),"INT")=$$HTFM^XLFDT(cnt)
 . Set AR(FFV,""""_$$HTFM^XLFDT(cnt),"EXT")=$$HTE^XLFDT(cnt)
 Quit
 ;
PointerList(FFV,FILE,FIELD,INDEX,AR)  ; Private
 New GLOBALROOT,NAME,IEN,FGIEN,FGI
 ; Create the Pointer List
 Set GLOBALROOT=$Piece(^DD(FILE,FIELD,0),"^",3)
 Set NAME=""
 For  Do  Quit:NAME=""
 . Set FGI="^"_GLOBALROOT_""""_INDEX_""","_""""_NAME_""")"
 . Set NAME=$Order(@FGI) Quit:NAME=""
 . Set IEN=0 For  Do  Quit:+IEN=0
 .. Set FGIEN="^"_GLOBALROOT_""""_INDEX_""","_""""_NAME_""","_IEN_")"
 .. Set IEN=$Order(@FGIEN) Quit:+IEN=0
 .. Set AR(FFV,""""_NAME,"INT")=IEN
 .. Set AR(FFV,""""_NAME,"EXT")=NAME
 Quit
 ;
ListSet()  ; Private
 New strval
 Set strval=""
 Set strval=strval_"["
 Set strval=strval_"""F130F638"","
 Set strval=strval_"""F130FP013"","
 Set strval=strval_"""F130FP011"","
 Set strval=strval_"""F130FP03"","
 Set strval=strval_"""F130FP035"","
 Set strval=strval_"""F130F661"","
 Set strval=strval_"""F130F1P01"","
 Set strval=strval_"""F130F1P035"","
 Set strval=strval_"""F130FP09"":{""START"":""10"",""END"":""10""},"
 Set strval=strval_"""F130FP04"":{""INDEX"":""B1""},"
 Set strval=strval_"""F130FP43"":{""INDEX"":""B""}"
 Set strval=strval_"]"
 Quit strval
 ;
patient(search)  ; Public
 New IEN,NAME,PLA,PLA,limit,outline,search1,search2
 Set search=$zcmdline
 Set limit=0
 If search'="xxxxxxxx" Do
 . If $Length(search)<1 Write "{}",! Quit
 . Set search=$Zconvert(search,"U")
 . If search[" " Do
 .. Set search1=$Piece(search," ",1)
 .. Set search2=$Piece(search," ",2)
 . If search'[" " Do
 .. Set search1=search
 .. Set (search2)=""
 . Set NAME=$Order(^DPT("B",search1),-1)
 . For  Do  Quit:NAME=""
 .. Set NAME=$Order(^DPT("B",NAME)) Quit:NAME=""
 .. Set IEN=0 For  Do  Quit:+IEN=0
 ... Set IEN=$Order(^DPT("B",NAME,IEN)) Quit:+IEN=0
 ... Quit:$Extract(NAME,1,$Length(search1))'=search1
 ... If search2'="",NAME'[search2 Quit
 ... Set limit=limit+1 Quit:limit>100
 ... Set PLA(NAME_IEN,"INT")=IEN
 ... Set PLA(NAME_IEN,"EXT")=NAME
 . Do ENCODE^XLFJSON("PLA","PLJ")
 . Set outline=0 For  Do  Quit:+outline=0
 .. Set outline=$Order(PLJ(outline)) Quit:+outline=0
 .. Write PLJ(outline)
 Quit
 ;
provider(search)  ; Public
 New IEN,NAME,PLA,PLJ,limit,outline,search1,search2
 Set search=$zcmdline
 Set limit=0
 If search'="xxxxxxxx" Do
 . If $Length(search)<1 Write "{}",! Quit
 . Set search=$Zconvert(search,"U")
 . If search[" " Set search1=$Piece(search," ",1),search2=$Piece(search," ",2)
 . If search'[" " Set search1=search,search2=""
 . Set NAME=$Order(^VA(200,"B",search1),-1)
 . For  Do  Quit:NAME=""
 .. Set NAME=$Order(^VA(200,"B",NAME)) Quit:NAME=""
 .. Set IEN=0 For  Do  Quit:+IEN=0
 ... Set IEN=$Order(^VA(200,"B",NAME,IEN)) Quit:+IEN=0
 ... Quit:$Extract(NAME,1,$Length(search1))'=search1
 ... If search2'="",NAME'[search2 Quit
 ... Set limit=limit+1 Quit:limit>100
 ... Set PLA(NAME_IEN,"INT")=IEN
 ... Set PLA(NAME_IEN,"EXT")=NAME
 . Do ENCODE^XLFJSON("PLA","PLJ")
 . Set outline=0 For  Do  Quit:+outline=0
 .. Set outline=$Order(PLJ(outline)) Quit:+outline=0
 .. Write PLJ(outline)
 Quit
 ;
procedure(search)  ; Public
 New WORD,limit,outline,search1,search2,search3,search4,search5,PLJA,PLJJ
 Set search=$zcmdline
 Set limit=0
 If search'="xxxxxxxx"  Do
 .  If $Length(search)<2 Write "{}",! Quit
 .  Set search=$Zconvert(search,"U")
 .  If search[" " Do
 .. Set search1=$Piece(search," ",1)
 .. Set search2=$Piece(search," ",2)
 .. Set search3=$Piece(search," ",3)
 .. Set search4=$Piece(search," ",4)
 .. Set search5=$Piece(search," ",5)
 . If search'[" " Do
 .. Set search1=search
 .. Set (search2,search3,search4,search5)=""
 . Set WORD=$Order(^ICD0("AD",31,search1),-1)
 . For  Do  Quit:WORD=""
 .. Set WORD=$Order(^ICD0("AD",31,WORD)) Quit:WORD=""
 .. Quit:$Extract(WORD,1,$Length(search1))'=search1
 .. Set IEN1=0 For  Do  Quit:+IEN1=0
 ... Set IEN1=$Order(^ICD0("AD",31,WORD,IEN1)) Quit:+IEN1=0
 ... Set DATE=$Order(^ICD0("AD",31,WORD,IEN1,""),-1)
 ... Set IEN2=$Order(^ICD0("AD",31,WORD,IEN1,DATE,0))
 ... Set CODE=$Piece(^ICD0(IEN1,0),"^",1)
 ... Set DESC=^ICD0(IEN1,68,IEN2,1)
 ... Set DESCU=$Zconvert(DESC,"U")
 ... If search2'="",DESCU'[search2 Quit
 ... If search3'="",DESCU'[search3 Quit
 ... If search4'="",DESCU'[search4 Quit
 ... If search5'="",DESCU'[search5 Quit
 ... Set limit=limit+1 Quit:limit>100
 ... Set PLJA(CODE,"EXT")=DESC
 ... Set PLJA(CODE,"INT")=IEN1
 . Do ENCODE^XLFJSON("PLJA","PLJJ")
 . Set outline=0 For  Do  Quit:+outline=0
 .. Set outline=$Order(PLJJ(outline)) Quit:+outline=0
 .. Write PLJJ(outline)
 Quit
 ;
do
 New request,json,array,FileField,FDA,FDAIEN,ERRORS
 Set request=$zcmdline Quit:request=""
 Write "<!DOCTYPE html>",!
 Write "<html>",!
 Write "<head>",!
 Write "  <title>Test Page for Post</title>",!
 Write "  <meta charset=""utf-8"">",!
 Write "   <meta name=""viewport"" content=""width=device-width, initial-scale=1"">",!
 Write " </head>",!
 Write " <body>",!
 Set json=$$convert(request)
 Do DECODE^XLFJSON("json","array")
 Set FileField="" For  Do  Quit:FileField=""
 . Set FileField=$Order(array(FileField)) Quit:FileField=""
 . Set FDA(1,$Extract($Piece(FileField,"-",1),2,999),"+1,",$Extract($Piece(FileField,"-",2),2,999))=array(FileField)
 Write "<table width=""100%""><tr><td><pre>",!
 ZWR array
 Write "</pre></td><td><pre>",!
 If $Data(FDA(1,130,"+1,",23)) Do
 . Set FDA(1,130.03,"+2,+1,",.01)=FDA(1,130,"+1,",23)
 . Kill FDA(1,130,"+1,",23)
 ZWR FDA
 Kill FDA(1,130,"+1,",27)   ; Planned Principal Procedure Code
 Kill FDA(1,130,"+1,",999)
 Write "</pre></td></tr>",!
 Do UPDATE^DIE("","FDA(1)","FDAIEN","ERRORS")
 Write "<tr><td><pre><hr/>",!
 If $Data(FDAIEN) ZWR FDAIEN
 Write "<hr/>",!
 If $Data(ERRORS) ZWR ERRORS
 Write "</pre></td></tr></table></body></html>",!
 Quit
 ;
convert(x)
 New y,z Set z=""
 For y=1:1:$Length(x,"%") Do
 . Set %HD=$Extract($Piece(x,"%",y),1,2) Do ^%HD
 . Set z=z_$C(%HD)_$Extract($Piece(x,"%",y),3,99)
 Quit $Translate(z,$c(13)_$c(10),"")