source: FOIAVistA/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/VAFCPDAT.m@ 1705

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

initial load of FOIAVistA 6/30/08 version
File size: 6.4 KB
Line 
1VAFCPDAT ;BIR/CML/ALS-DISPLAY MPI/PD INFORMATION FOR SELECTED PATIENT ;10/24/02 13:13
2 ;;5.3;Registration;**333,414,474,505,707**;Aug 13, 1993;Build 14
3 ;Registration has IA #3299 for MPI/PD to call START^VAFCPDAT
4 ;
5 ;variable DFN is not NEWed or KILLed in this routine as that variable is passed in
6 ;
7MAIN ; Entry point with device call
8 S NOTRPC=1
9 K ZTSAVE S ZTSAVE("DFN")=""
10 D EN^XUTMDEVQ("START^VAFCPDAT","Print MPI/PD Patient Data",.ZTSAVE)
11 K NOTRPC
12 Q
13 ;
14START ;Entry point without device call, used for RPC calls
15 S $P(LN,"=",80)="",$P(LN2,"=",60)="",QFLG=0
16 D NOW^%DTC S HDT=$$FMTE^XLFDT($E(%,1,12))
17 S SITE=$$SITE^VASITE(),SITENAM=$P(SITE,"^",2),SITENUM=$P(SITE,"^",3),SITEIEN=$P(SITE,"^")
18 I +DFN<0 D Q
19 .I $D(NOTRPC) W @IOF,!," "
20 .W !,"ICN ",$G(ICN)," does not exist at ",SITENAM,"."
21 .W !,"Search date: ",HDT,!,LN
22 S DIC=2,DR=".01;.02;.03;.09;.111;.112;.113;.114;.115;.1112;.131;.313;.351;994;.0907;.0906",DA=DFN,DIQ(0)="EI",DIQ="DNODE" ;**707
23 N NAME,SSN,DOB,SEX,CLAIM,DOD,ICN,STR1,STR2,STR3,CTY,ST,ZIP,PHN,MBI,SSNVER,PREAS ;**707
24 D EN^DIQ1 K DIC,DR,DA,DIQ
25 S NAME=$G(DNODE(2,DFN,.01,"E")),SSN=$G(DNODE(2,DFN,.09,"E"))
26 S DOB=$$FMTE^XLFDT($G(DNODE(2,DFN,.03,"I")))
27 S MBI=$G(DNODE(2,DFN,994,"I")),MBI=$S(MBI="Y":"YES",MBI="N":"NO",1:"NULL") ;**707
28 S SEX=$G(DNODE(2,DFN,.02,"E")),DOD=$G(DNODE(2,DFN,.351,"E"))
29 S CLAIM=$G(DNODE(2,DFN,.313,"E")) S:CLAIM="" CLAIM="None"
30 S STR1=$G(DNODE(2,DFN,.111,"E")),STR2=$G(DNODE(2,DFN,.112,"E")),STR3=$G(DNODE(2,DFN,.113,"E"))
31 S CTY=$G(DNODE(2,DFN,.114,"E")),ST=$G(DNODE(2,DFN,.115,"E")),ZIP=$G(DNODE(2,DFN,.1112,"E"))
32 S PHN=$G(DNODE(2,DFN,.131,"E"))
33 S SSNVER=$G(DNODE(2,DFN,.0907,"E")) ;**707
34 S PREAS=$G(DNODE(2,DFN,.0906,"E")) ;**707
35 S MNODE=$$MPINODE^MPIFAPI(DFN) I +MNODE=-1 S MNODE="^^^^^"
36 S (ICN,CMOR,SCN,SCORE,SCRDT,DIFF)=""
37 S ICN=$P($G(MNODE),"^") S:ICN="" ICN="None"
38 S CMOR=$$GET1^DIQ(4,+$P($G(MNODE),"^",3)_",",.01) S:CMOR="" CMOR="None"
39 I $E(ICN,1,3)=SITENUM S GOT=0 D
40 . I $P($G(MNODE),"^",4)=""!('$D(^DPT("AICNL",1,DFN))) S ICN=ICN_"**"
41 ;
42 I $D(NOTRPC) W @IOF,!
43 W !,"MPI/PD Data for: ",NAME," (DFN #",DFN,")"
44 ; check for patient sensitivity and user security
45 N RESULT,RGSENS,SENSTV,DA,DR,DIC,DIQ,VAFCSEN
46 D PTSEC^DGSEC4(.RESULT,DFN,0,"MPI/PD Patient Inquiry^MPI/PD Patient Inquiry")
47 I RESULT(1)=-1 W !!,"Access denied: Required parameters not defined" G QUIT
48 I RESULT(1)>0 W ?50,"***PATIENT MARKED SENSITIVE***"
49 I RESULT(1)=3 W !!,"Access not allowed on your own PATIENT (#2) file entry" G QUIT
50 I RESULT(1)=4 W !!,"Access denied: Your SSN is not defined" G QUIT
51 I RESULT(1)<3 D
52 . I RESULT(1)=1 D NOTICE^DGSEC4(.VAFCSEN,DFN,"RPC - VAFC REMOTE PDAT FROM THE MPI^MPI/PD Patient Inquiry (Remote)",2) ;IA #3027
53 . I RESULT(1)=2 D NOTICE^DGSEC4(.VAFCSEN,DFN,"RPC - VAFC REMOTE PDAT FROM THE MPI^MPI/PD Patient Inquiry (Remote)",3) ;IA #3027
54 W !,"Printed ",HDT," at ",SITENAM,!,LN
55 S $Y=$Y+1
56 ;next 7 lines modified for **707
57 W !,"ICN : ",ICN,?40,"CMOR: ",CMOR
58 W !,"SSN : ",SSN
59 I SSNVER]"" W !?9,"SSN Verification Status: ",SSNVER
60 I SSNVER="",PREAS]"" W !?9,"Pseudo SSN Reason: ",PREAS
61 I SSNVER]"",PREAS]"" W !?9,"Pseudo SSN Reason : ",PREAS
62 W !,"Sex : ",SEX
63 W !,"Claim #: ",CLAIM
64 W !,"Date of Birth: ",DOB
65 I DOD]"" W !,"Date of Death: ",DOD
66 I MBI]"" W !,"Multiple Birth Indicator: ",MBI ;**707
67 W !,"Address: ",STR1
68 I STR2'="" W !?9,STR2
69 I STR3'="" W !?9,STR3
70 I CTY'="" W !?9,$E(CTY,1,20)_", "_$G(ST)_" "_$G(ZIP)
71 I PHN'="" W !,"Phone #: ",PHN
72 I $G(IOSL)<30&($E(IOST,1,2)="C-") D
73 .I $Y>23 D
74 ..S DIR(0)="E" D D ^DIR K DIR I 'Y S QFLG=1
75 ...S SS=22-$Y F JJ=1:1:SS W !
76 ..S $Y=0
77 I QFLG=1 G QUIT
78 ;
79TF ;List Treating Facilities for this patient
80 D TFHDR
81 K TFARR
82 S TF=0 F S TF=$O(^DGCN(391.91,"APAT",DFN,TF)) Q:'TF D
83 .S TFIEN=$O(^DGCN(391.91,"APAT",DFN,TF,0))
84 . S DIC="^DGCN(391.91,",DR=".02;.03;.07",DA=TFIEN,DIQ(0)="EI",DIQ="TFDATA"
85 . D EN^DIQ1 K DIC,DA,DR,DIQ
86 . S INST="",STATION=""
87 . S INST=$G(TFDATA(391.91,TFIEN,.02,"I"))
88 . I INST'="" D
89 .. S DIC=4,DR="99",DA=INST,DIQ(0)="E",DIQ="STA"
90 .. D EN^DIQ1 K DIC,DA,DR,DIQ
91 .. S STATION=$G(STA(4,INST,99,"E"))
92 . S TFNM=$G(TFDATA(391.91,TFIEN,.02,"E"))
93 . S LSTDT=$G(TFDATA(391.91,TFIEN,.03,"I")) S:LSTDT="" LSTDT="none found"
94 . S LSTSORT=9999999
95 . I +LSTDT S LSTSORT=9999999-LSTDT,LSTDT=$$FMTE^XLFDT($E(LSTDT,1,12))
96 . S REACODE=$G(TFDATA(391.91,TFIEN,.07,"E")) S REASON="none found"
97 . I REACODE'="" D
98 .. S DIC="^VAT(391.72,",DIC(0)="Z",X=REACODE D ^DIC K DIC,X
99 .. S REASON=$P($G(Y(0)),"^",4)
100 . S TFARR(LSTSORT,TFNM)=TFIEN_"^"_REASON_"^"_$G(STATION)_"^"_LSTDT
101 I '$D(TFARR) W !,"No Treating Facilities found." G SUB
102 S LSTSORT=0 F S LSTSORT=$O(TFARR(LSTSORT)) Q:'LSTSORT D G:QFLG QUIT
103 .S TFNM="" F S TFNM=$O(TFARR(LSTSORT,TFNM)) Q:TFNM="" D Q:QFLG
104 ..S REASON=$P(TFARR(LSTSORT,TFNM),"^",2)
105 ..S STATION=$P(TFARR(LSTSORT,TFNM),"^",3)
106 ..S LSTDT=$P(TFARR(LSTSORT,TFNM),"^",4)
107 ..I $Y+3>IOSL&($E(IOST,1,2)="C-") D Q:QFLG
108 ...S LNQ=22 D SS Q:QFLG
109 ...W @IOF,!,"MPI/PD data for: ",NAME," (DFN #",DFN,")",!,LN2 D TFHDR
110 ..W !,$E(TFNM,1,20),?22,$G(STATION),?32,LSTDT,?54,REASON
111SUB ;removed listing of subscribers for RG*1.0*23
112HIS ;find ICN history
113 I '$O(^DPT(DFN,"MPIFHIS",0)) G CONT
114 ;
115 I $Y+4>IOSL&($E(IOST,1,2)="C-") D G:QFLG QUIT
116 .S LNQ=22 D SS Q:QFLG
117 .W @IOF,!,"MPI/PD data for: ",NAME," (DFN #",DFN,")",!,LN2
118 D ICNHDR
119 S HIS=0 F S HIS=$O(^DPT(DFN,"MPIFHIS",HIS)) Q:'HIS D G:QFLG QUIT
120 .S DIC=2,DR="992",DR(2.0992)=".01;3",DA=DFN,DA(2.0992)=HIS
121 .S DIQ(0)="E",DIQ="HISNODE"
122 .D EN^DIQ1 K DIC,DA,DR,DIQ
123 .S HISICN=$G(HISNODE(2.0992,HIS,.01,"E"))
124 .S HISDT=$G(HISNODE(2.0992,HIS,3,"E"))
125 .I $Y+3>IOSL&($E(IOST,1,2)="C-") D Q:QFLG
126 ..S LNQ=22 D SS Q:QFLG
127 ..W @IOF,!,"MPI/PD data for: ",NAME," (DFN #",DFN,")",!,LN2 D ICNHDR
128 .W !,HISICN I HISDT]"" W " - changed ",HISDT
129 ;
130CONT ;Continue to VAFCPDT2 for CMOR data and extended data
131 D CMORHIS^VAFCPDT2
132DONE ;
133 I QFLG G QUIT
134 I ($E(IOST,1,2)="C-") S LNQ=24 D SS
135 ;
136QUIT ;
137 K %,CMOR,DIC,DIR,DIRUT,DNODE,GOT,HDT,HIS,HISDT,HISICN,JJ,LIEN,LINST
138 K LN,LSTDT,MNODE,REACODE,REASON,SCN,SCORE,SITE,SITEIEN,SITENAM,SITENUM
139 K SS,SUBN,SUBARR,TERM,TERMDT,TF,TFARR,TFDATA,TFIEN,TFNM,Y,D,CHG,CHGNODE
140 K HISNODE,DIFF,INST,RGDFN,SCRDT,STATION,STA,LN2,NAME,LSTSORT,LNQ,QFLG,MBI
141 Q
142TFHDR ;
143 W !!,"Treating Facilities:",?22,"Station:",?32,"DT Last Treated",?54,"Event Reason"
144 W !,"--------------------",?22,"--------",?32,"---------------",?54,"------------"
145 Q
146ICNHDR W !!,"ICN History:",!,"------------"
147 Q
148 ;
149SS S DIR(0)="E" D D ^DIR K DIR I 'Y S QFLG=1
150 .S SS=LNQ-$Y F JJ=1:1:SS W !
151 Q
Note: See TracBrowser for help on using the repository browser.