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

Last change on this file since 702 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.1 KB
Line 
1VFGSCN01 ;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
5SERVER(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
46ADDNL(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
74EDTSITE(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
93DOBLKUP(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
Note: See TracBrowser for help on using the repository browser.