source: WorldVistAEHR/trunk/r/VENDOR_VOES-VFGS/VFGSCN01.m@ 837

VFGSCN01 ;voes/swo scan and view utils; 17 Jan 2007 12:28PM

 ;;2.1;VOES Scanning;****;8.7.2007;Build 4

 ;no entry from top

 Q

SERVER(VFGOUT) ;check server files

 ; 

 ; RPC:

 ;   VFGS SCANNING SERVER INFO

 ;

 ; Input:

 ;   None

 ;

 ; Output:

 ;   VFGOUT message array. Returns status of Imaging Site Parameters and

 ;   Network Locations

 ;

 N VFG0,VFG00,VFG1,VFG2,VFG3,VFG4

 S U="^"

 S VFG0=$G(^MAG(2005.2,0))

 S VFG00=$G(^MAG(2006.1,0))

 I $P(VFG00,U,4)<1 D  Q

 .S VFG3(0)="Imaging Site Parameters Missing"

 .S VFG3(1)=""

 .S VFG3(2)="Contact Technical Assistance"

 .Q

 I ($P($G(^MAG(2006.1,1,0)),U)'?.N)&($O(^MAG(2006.1,"B",""))) D  Q

 .S VFG3(0)="Imaging Site Parameters Corrupted"

 .S VFG3(1)=""

 .S VFG3(2)="Contact Technical Assistance"

 .Q

 I $P(VFG0,U,4)<1 D  Q

 .S VFG3(0)="Network Locations are Undefined"

 .Q

 S VFG3(0)="Number of Network Locations Defined: "_$P(VFG0,U,4)

 S VFG3(1)="",VFG4=1

 S VFG1=0 F  S VFG1=$O(^MAG(2005.2,VFG1)) Q:'VFG1  D

 .S VFG2=$G(^MAG(2005.2,VFG1,0)) Q:VFG2=""  D

 .S VFG4=VFG4+1,VFG3(VFG4)="NETWORK LOCATION  : "_$P(VFG2,U)

 .S VFG4=VFG4+1,VFG3(VFG4)="PHYSICAL REFERENCE: "_$P(VFG2,U,2)

 .S VFG4=VFG4+1,VFG3(VFG4)="OPERATIONAL STATUS: "_$S($P(VFG2,U,6)=0:"Off-line",1:"On-line")

 .S VFG4=VFG4+1,VFG3(VFG4)="STORAGE DIRECTORY : "_$P(VFG2,U,7)

 .S VFG4=VFG4+1,VFG3(VFG4)="HASH SUBDIRECTORY : "_$P(VFG2,U,8)

 .S VFG4=VFG4+1,VFG3(VFG4)=""

 M VFGOUT=VFG3

 Q

ADDNL(RESULT,VFGADD) ;add new entry for 2005.2 Network Location

 ; **Under Construction**

 ; RPC:

 ;  VFGS SCANNING ADD NETLOC

 ; Input:

 ;  VFGSADD ARRAY FROM GUI

 ;

 ;  FILE    Field # Array Item          Value

 ;  2005.2  .01    VFGADD("NETLOC")       = FREE TEXT 3-30 alpha/numeric, no 

 ;                                          spaces or punctuation

 ;  2005.2    1    VFGADD("PHYREF")       = FREE TEXT 1-120

 ;  2005.2    5    VFGADD("OSTAT")        = ""

 ;  2005.2    6    VFGADD("STYPE")        = "MAG"

 ;  2005.2    7    VFGADD("HASH")         = "Y"

 ;

 ;  Output

 ;     None

 ; setup the FDA

 K FDA

 S FDA("ADD",2005.2,"+1,",.01)=VFGADD("NETLOC")

 S FDA("ADD",2005.2,"+1,",1)=VFGADD("PHYREF")

 S FDA("ADD",2005.2,"+1,",5)=VFGADD("OSTAT")

 S FDA("ADD",2005.2,"+1,",6)=VFGADD("STYPE")

 S FDA("ADD",2005.2,"+1,",7)=VFGADD("HASH")

 ; passing external values to the call

 D UPDATE^DIE("E","FDA(""ADD"")")

 S RESULT=$NA(^TMP("DIERR",$J))

 Q

EDTSITE(RESULT,VFGEDT) ;

 ; **Under Construction**

 ; RPC:

 ;  VFGS SCANNING SITE EDIT

 ; Input:

 ;  VFGSEDT ARRAY FROM GUI

 ;

 ;  FILE    Field # Array Item          Value

 ;  2006.1  .03    VFGEDT("WRTLOC")       = the value entered for VFGEDT("NETLOC")

 ; Output

 ;   None

 ;   

 ;  setup the FDA

 S FDA("EDT",2006.1,",1",.03)=VFGEDT("WRTLOC")

 ; passing external values to the call

 D FILE^DIE("E","FDA(""EDT"")")

 S RESULT=$NA(^TMP("DIERR",$J))

 Q

 ;voes/rgg added following function for patient date of birth lookups

DOBLKUP(RESULT,DOB)

 ; Lookup patients by date of birth

 ; RPC:

 ;  VFG DOB LOOKUP

 ; Input:

 ;  Birth date from GUI

 ; Output:

 ;  Listing of patients matching date of birth

 ; First convert date provided into Fileman format

 S %DT="",X=DOB

 D ^%DT

 S DOB=Y

 K %DT

 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)

 Q