source: FOIAVistA/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNFSRV0.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 3.5 KB
Line 
1SPNFSRV0 ;HISC/DAD-SCD REGISTRY VETERAN SURVEY SERVER ;2/6/96 09:34
2 ;;2.0;Spinal Cord Dysfunction;;01/02/1997
3 ;
4 D XIT
5 S SPNFXMZ=XMZ
6 S SPNFTYPE=$$XMREC,SPNERROR=0
7 I ";***154^REG;***154.1^FIM;"'[(";"_SPNFTYPE_";") D G EXIT
8 . S X="Invalid message format, rest of message ignored."
9 . D ERROR(X)
10 . Q
11 K SPNFDATA
12 S (SPNFREGC,SPNFFIMC,SPNFEXIT,SPNFDATA("E"))=0
13 F S SPNFDATA=$$XMREC Q:SPNFDATA=""!SPNFEXIT D
14 . ;
15 . I SPNFDATA="***^END" D Q
16 .. S X=$O(SPNFDATA("")) I (X="")!(X="E") Q
17 .. S SPNFDFN(0)=$P($G(SPNFDATA(0)),U)
18 .. S SPNFDFN=$$FINDDFN(SPNFDFN(0))
19 .. I SPNFDFN'>0 D Q
20 ... S SPNFNAME=$P(SPNFDFN(0),";"),SPNFSEX=$P(SPNFDFN(0),";",2)
21 ... S SPNFDOB=$P(SPNFDFN(0),";",3),SPNFSSN=$P(SPNFDFN(0),";",4)
22 ... S SPNFDOB=$E(SPNFDOB,4,5)_"-"_$E(SPNFDOB,6,7)_"-"_$E(SPNFDOB,2,3)
23 ... S SPNFSEX=$S(SPNFSEX="M":"MALE",SPNFSEX="F":"FEMALE",1:"UNKNOWN")
24 ... S X="Patient not found: "_SPNFNAME_" ("_SPNFSEX_") "
25 ... S X=X_SPNFDOB_" "_SPNFSSN_"."
26 ... K SPNFDATA S SPNFDATA("E")=0
27 ... D ERROR(X)
28 ... Q
29 .. I $P(SPNFTYPE,U,2)="REG" D REG^SPNFSRV1
30 .. I $P(SPNFTYPE,U,2)="FIM" D FIM^SPNFSRV2
31 .. K SPNFDATA S SPNFDATA("E")=0
32 .. Q
33 . ;
34 . S SPNFTAG=$P(SPNFDATA,U),SPNFDATA=$P(SPNFDATA,U,2,99)
35 . S SPNFSUB=$TR(SPNFTAG,"*")
36 . I (SPNFTAG'?1"*"1E1"*")!("^0^2^5^E^"'[(U_SPNFSUB_U)) D Q
37 .. S X="Invalid message format, rest of message ignored."
38 .. D ERROR(X)
39 .. S SPNFEXIT=1
40 .. Q
41 . I SPNFSUB?1N S SPNFDATA(SPNFSUB)=SPNFDATA
42 . E D
43 .. S SPNFDATA("E")=SPNFDATA("E")+1
44 .. S SPNFDATA("E",SPNFDATA("E"))=SPNFDATA
45 .. Q
46 . Q
47 ;
48EXIT ; *** Send error/info msg, Clean-up, Quit
49 I SPNERROR'>0 S XMSER="SPNFSURVEY",XMZ=SPNFXMZ D REMSBMSG^XMA1C
50 D MESSAGE
51XIT K D0,D1,DA,DD,DESC,DFN,DIC,DIE,DINUM,DLAYGO,DO,DOB,DPT,DR,DTOUT,IEN
52 K NAM,SEX,SPND0,SPND1,SPNDATE,SPNDR,SPNERROR,SPNETIOL,SPNFDATA
53 K SPNFDATE,SPNFDFN,SPNFDOB,SPNFEXIT,SPNFFIMC,SPNFFLDS,SPNFFTYP
54 K SPNFNAME,SPNFREGC,SPNFSEX,SPNFSSN,SPNFSTAT,SPNFSUB,SPNFTAG,SPNFTYPE
55 K SPNFXMZ,SPNONSET,SPNOTHER,SPNPIECE,SPNX,SSN,TYPE,X,Y
56 K ^TMP($J,"SPNERROR")
57 Q
58 ;
59MESSAGE ; *** Send user error/info message
60 I SPNERROR D
61 . S X="The SCD Registry Veteran Survey Server has encountered the"
62 . S ^TMP($J,"SPNERROR",.1)=X
63 . S X="following problems with MailMan server message # "_SPNFXMZ_":"
64 . S ^TMP($J,"SPNERROR",.2)=X
65 . S ^TMP($J,"SPNERROR",.3)=""
66 . Q
67 E D
68 . S X="The SCD Registry Veteran Survey Server has added or modified"
69 . S ^TMP($J,"SPNERROR",.1)=X
70 . S X="the following number of records:"
71 . S ^TMP($J,"SPNERROR",.2)=X
72 . I $P(SPNFTYPE,U,2)="REG" D
73 .. S ^TMP($J,"SPNERROR",.3)=" SCD Registry records: "_SPNFREGC
74 .. Q
75 . I $P(SPNFTYPE,U,2)="FIM" D
76 .. S ^TMP($J,"SPNERROR",.3)=" FIM records: "_SPNFFIMC
77 .. Q
78 . Q
79 S XMSUB="SCD Registry Veteran Survey Server"
80 S XMTEXT="^TMP($J,""SPNERROR"","
81 S XMY("G.SPNL SCD COORDINATOR")=""
82 S XMY("G.SPNZ SCD COORDINATOR")=""
83 D ^XMD
84 Q
85 ;
86FINDDFN(X) ; *** Find a patient DFN
87 ; X = Name ; Sex ; DOB ; SSN ; LAST NAME
88 N D0,DFN,DOB,DPT,LNM,NAM,SEX,SSN
89 S NAM=$P(X,";",1),SEX=$P(X,";",2)
90 S DOB=$P(X,";",3),SSN=$P(X,";",4)
91 S LNM=$P(X,";",5)
92 S (D0,DFN)=0
93 F S D0=$O(^DPT("SSN",SSN,D0)) Q:D0'>0!DFN D
94 . S DPT=$G(^DPT(D0,0))
95 . S NAM(0)=$P(DPT,U,1),SEX(0)=$P(DPT,U,2)
96 . S DOB(0)=$P(DPT,U,3),SSN(0)=$P(DPT,U,9)
97 . I NAM=NAM(0),SEX=SEX(0),DOB=DOB(0),SSN=SSN(0) S DFN=D0
98 . I DFN'>0,SSN=SSN(0),LNM=$P(NAM(0),",") S DFN=D0
99 . Q
100 Q DFN
101 ;
102ERROR(X) ; *** Save error messages
103 ; X = Text of the error msg
104 S SPNERROR=SPNERROR+1
105 S ^TMP($J,"SPNERROR",SPNERROR)=X
106 Q
107 ;
108XMREC() ; *** Return next line of message
109 X XMREC
110 Q $S(XMER=0:XMRG,1:"")
Note: See TracBrowser for help on using the repository browser.