| 1 | VFGSCN01 ;voes/swo scan and view utils; 17 Jan 2007 12:28PM | 
|---|
| 2 | ;;2.1;VOES Scanning;****;8.7.2007;Build 4 | 
|---|
| 3 | ;no entry from top | 
|---|
| 4 | Q | 
|---|
| 5 | SERVER(VFGOUT) ;check server files | 
|---|
| 6 | ; | 
|---|
| 7 | ; RPC: | 
|---|
| 8 | ;   VFGS SCANNING SERVER INFO | 
|---|
| 9 | ; | 
|---|
| 10 | ; Input: | 
|---|
| 11 | ;   None | 
|---|
| 12 | ; | 
|---|
| 13 | ; Output: | 
|---|
| 14 | ;   VFGOUT message array. Returns status of Imaging Site Parameters and | 
|---|
| 15 | ;   Network Locations | 
|---|
| 16 | ; | 
|---|
| 17 | N VFG0,VFG00,VFG1,VFG2,VFG3,VFG4 | 
|---|
| 18 | S U="^" | 
|---|
| 19 | S VFG0=$G(^MAG(2005.2,0)) | 
|---|
| 20 | S VFG00=$G(^MAG(2006.1,0)) | 
|---|
| 21 | I $P(VFG00,U,4)<1 D  Q | 
|---|
| 22 | .S VFG3(0)="Imaging Site Parameters Missing" | 
|---|
| 23 | .S VFG3(1)="" | 
|---|
| 24 | .S VFG3(2)="Contact Technical Assistance" | 
|---|
| 25 | .Q | 
|---|
| 26 | I ($P($G(^MAG(2006.1,1,0)),U)'?.N)&($O(^MAG(2006.1,"B",""))) D  Q | 
|---|
| 27 | .S VFG3(0)="Imaging Site Parameters Corrupted" | 
|---|
| 28 | .S VFG3(1)="" | 
|---|
| 29 | .S VFG3(2)="Contact Technical Assistance" | 
|---|
| 30 | .Q | 
|---|
| 31 | I $P(VFG0,U,4)<1 D  Q | 
|---|
| 32 | .S VFG3(0)="Network Locations are Undefined" | 
|---|
| 33 | .Q | 
|---|
| 34 | S VFG3(0)="Number of Network Locations Defined: "_$P(VFG0,U,4) | 
|---|
| 35 | S VFG3(1)="",VFG4=1 | 
|---|
| 36 | S VFG1=0 F  S VFG1=$O(^MAG(2005.2,VFG1)) Q:'VFG1  D | 
|---|
| 37 | .S VFG2=$G(^MAG(2005.2,VFG1,0)) Q:VFG2=""  D | 
|---|
| 38 | .S VFG4=VFG4+1,VFG3(VFG4)="NETWORK LOCATION  : "_$P(VFG2,U) | 
|---|
| 39 | .S VFG4=VFG4+1,VFG3(VFG4)="PHYSICAL REFERENCE: "_$P(VFG2,U,2) | 
|---|
| 40 | .S VFG4=VFG4+1,VFG3(VFG4)="OPERATIONAL STATUS: "_$S($P(VFG2,U,6)=0:"Off-line",1:"On-line") | 
|---|
| 41 | .S VFG4=VFG4+1,VFG3(VFG4)="STORAGE DIRECTORY : "_$P(VFG2,U,7) | 
|---|
| 42 | .S VFG4=VFG4+1,VFG3(VFG4)="HASH SUBDIRECTORY : "_$P(VFG2,U,8) | 
|---|
| 43 | .S VFG4=VFG4+1,VFG3(VFG4)="" | 
|---|
| 44 | M VFGOUT=VFG3 | 
|---|
| 45 | Q | 
|---|
| 46 | ADDNL(RESULT,VFGADD) ;add new entry for 2005.2 Network Location | 
|---|
| 47 | ; **Under Construction** | 
|---|
| 48 | ; RPC: | 
|---|
| 49 | ;  VFGS SCANNING ADD NETLOC | 
|---|
| 50 | ; Input: | 
|---|
| 51 | ;  VFGSADD ARRAY FROM GUI | 
|---|
| 52 | ; | 
|---|
| 53 | ;  FILE    Field # Array Item          Value | 
|---|
| 54 | ;  2005.2  .01    VFGADD("NETLOC")       = FREE TEXT 3-30 alpha/numeric, no | 
|---|
| 55 | ;                                          spaces or punctuation | 
|---|
| 56 | ;  2005.2    1    VFGADD("PHYREF")       = FREE TEXT 1-120 | 
|---|
| 57 | ;  2005.2    5    VFGADD("OSTAT")        = "" | 
|---|
| 58 | ;  2005.2    6    VFGADD("STYPE")        = "MAG" | 
|---|
| 59 | ;  2005.2    7    VFGADD("HASH")         = "Y" | 
|---|
| 60 | ; | 
|---|
| 61 | ;  Output | 
|---|
| 62 | ;     None | 
|---|
| 63 | ; setup the FDA | 
|---|
| 64 | K FDA | 
|---|
| 65 | S FDA("ADD",2005.2,"+1,",.01)=VFGADD("NETLOC") | 
|---|
| 66 | S FDA("ADD",2005.2,"+1,",1)=VFGADD("PHYREF") | 
|---|
| 67 | S FDA("ADD",2005.2,"+1,",5)=VFGADD("OSTAT") | 
|---|
| 68 | S FDA("ADD",2005.2,"+1,",6)=VFGADD("STYPE") | 
|---|
| 69 | S FDA("ADD",2005.2,"+1,",7)=VFGADD("HASH") | 
|---|
| 70 | ; passing external values to the call | 
|---|
| 71 | D UPDATE^DIE("E","FDA(""ADD"")") | 
|---|
| 72 | S RESULT=$NA(^TMP("DIERR",$J)) | 
|---|
| 73 | Q | 
|---|
| 74 | EDTSITE(RESULT,VFGEDT) ; | 
|---|
| 75 | ; **Under Construction** | 
|---|
| 76 | ; RPC: | 
|---|
| 77 | ;  VFGS SCANNING SITE EDIT | 
|---|
| 78 | ; Input: | 
|---|
| 79 | ;  VFGSEDT ARRAY FROM GUI | 
|---|
| 80 | ; | 
|---|
| 81 | ;  FILE    Field # Array Item          Value | 
|---|
| 82 | ;  2006.1  .03    VFGEDT("WRTLOC")       = the value entered for VFGEDT("NETLOC") | 
|---|
| 83 | ; Output | 
|---|
| 84 | ;   None | 
|---|
| 85 | ; | 
|---|
| 86 | ;  setup the FDA | 
|---|
| 87 | S FDA("EDT",2006.1,",1",.03)=VFGEDT("WRTLOC") | 
|---|
| 88 | ; passing external values to the call | 
|---|
| 89 | D FILE^DIE("E","FDA(""EDT"")") | 
|---|
| 90 | S RESULT=$NA(^TMP("DIERR",$J)) | 
|---|
| 91 | Q | 
|---|
| 92 | ;voes/rgg added following function for patient date of birth lookups | 
|---|
| 93 | DOBLKUP(RESULT,DOB) | 
|---|
| 94 | ; Lookup patients by date of birth | 
|---|
| 95 | ; RPC: | 
|---|
| 96 | ;  VFG DOB LOOKUP | 
|---|
| 97 | ; Input: | 
|---|
| 98 | ;  Birth date from GUI | 
|---|
| 99 | ; Output: | 
|---|
| 100 | ;  Listing of patients matching date of birth | 
|---|
| 101 | ; First convert date provided into Fileman format | 
|---|
| 102 | S %DT="",X=DOB | 
|---|
| 103 | D ^%DT | 
|---|
| 104 | S DOB=Y | 
|---|
| 105 | K %DT | 
|---|
| 106 | S XX="",I=0 F  S XX=$O(^DPT("ADOB",Y,XX)) Q:'XX  S I=I+1 S RESULT(I)=XX_"^"_^DPT(XX,0) | 
|---|
| 107 | Q | 
|---|