source: FOIAVistA/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXKMASC.m@ 899

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

initial load of FOIAVistA 6/30/08 version
File size: 6.6 KB
Line 
1PXKMASC ;ISL/JVS - Build and Pass to auto-check-out ;7/25/96 08:53
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**22,41,73,164**;Aug 12, 1996
3 ; Builds and passes data to MAS for Auto-checkout
4 ;Variable List
5 ;
6EN1 ;Build the Temp global for MAS AND THE WORLD.
7 ;S PXKGN=$P($T(GLOBAL^@PXKRTN),";;",2)_"("_PXKPIEN_","
8 ;^TMP("PXKCO",$J,<VISIT IEN>,"PRV",<PROVIDER ien>,0,"AFTER")=DATA
9 ; "" "" "" ,"BEFORE")=DATA
10 N PXKGG,PXKSUB,PXKMOD,PXKSEQ,PXKOE ;PX*1.0*164
11 Q:PXKSOR=$O(^PX(839.7,"B","PIMS CHECK-OUT",0))
12 S PXKGG=0
13 S PXKSUB=""
14 F S PXKSUB=$O(PXKAFT(PXKSUB)) Q:PXKSUB="" D
15 . I PXKSUB'=1 D PXGO Q
16 . S PXKSEQ=""
17 . F S PXKSEQ=$O(PXKAFT(PXKSUB,PXKSEQ)) Q:PXKSEQ="" D
18 .. S PXKMOD=PXKAFT(PXKSUB,PXKSEQ)
19 .. D PXGO
20 Q
21PXGO ;
22 S PXKGG=0
23 S PXKGN=$P($T(GLOBAL^@PXKRTN),";;",2)_"("_PXKPIEN_","
24 I PXKSUB'=1 D
25 . I $D(^TMP("PXKCO",$J,PXKVST,PXKCAT,PXKPIEN,PXKSUB,"BEFORE")) S PXKGG=1
26 . S PXKGN=PXKGN_PXKSUB_")"
27 I PXKSUB=1 D
28 . I PXKMOD]"",$D(^TMP("PXKCO",$J,PXKVST,PXKCAT,PXKPIEN,PXKSUB,"BEFORE",PXKMOD)) S PXKGG=1
29 . S PXKGN=PXKGN_PXKSUB_","_PXKSEQ_","_0_")"
30 D @$S(PXKGG=1:"DUP",1:"ORG")
31 D DEL
32 D PTR
33 Q
34 ;
35DUP ;Overwrite if a duplicate just the After Node
36 I PXKSUB'=1 D Q
37 . S ^TMP("PXKCO",$J,PXKVST,PXKCAT,PXKPIEN,PXKSUB,"AFTER")=$G(@PXKGN)
38 I $G(@PXKGN)]"" D
39 . S ^TMP("PXKCO",$J,PXKVST,PXKCAT,PXKPIEN,PXKSUB,"AFTER",$G(@PXKGN))=""
40 Q
41 ;
42ORG ;If original copy both
43 I PXKSUB'=1 D Q
44 . S ^TMP("PXKCO",$J,PXKVST,PXKCAT,PXKPIEN,PXKSUB,"AFTER")=$G(@PXKGN)
45 . S ^TMP("PXKCO",$J,PXKVST,PXKCAT,PXKPIEN,PXKSUB,"BEFORE")=$G(PXKBEF(PXKSUB))
46 I $G(@PXKGN)]"" D
47 . S ^TMP("PXKCO",$J,PXKVST,PXKCAT,PXKPIEN,PXKSUB,"AFTER",$G(@PXKGN))=""
48 I $G(PXKBEF(PXKSUB,PXKSEQ))]"" D
49 . S ^TMP("PXKCO",$J,PXKVST,PXKCAT,PXKPIEN,PXKSUB,"BEFORE",PXKBEF(PXKSUB,PXKSEQ))=""
50 Q
51 ;
52DEL ;DELETE IF BOTH ARE NULL
53 I '$D(^TMP("PXKCO",$J,PXKVST,PXKCAT,PXKPIEN,0)) D
54 .K ^TMP("PXKCO",$J,PXKVST,PXKCAT,PXKPIEN)
55 I $G(^TMP("PXKCO",$J,PXKVST,PXKCAT,PXKPIEN,0,"AFTER"))']"" D
56 .I $G(^TMP("PXKCO",$J,PXKVST,PXKCAT,PXKPIEN,0,"BEFORE"))']"" D
57 ..K ^TMP("PXKCO",$J,PXKVST,PXKCAT,PXKPIEN)
58 I $P($G(^TMP("PXKCO",$J,PXKVST,PXKCAT,PXKPIEN,0,"AFTER")),"^",1)="@" D
59 .K ^TMP("PXKCO",$J,PXKVST,PXKCAT,PXKPIEN)
60 Q
61 ;
62PTR ; Set the Provider Narrative equal to the pointer in the files etc.
63 N PXJ,PXJJ,PXJJJ,PXKR
64 I $D(PXKPTR) S PXJ="" F S PXJ=$O(PXKPTR(PXJ)) Q:PXJ="" D
65 .S PXJJ="" F S PXJJ=$O(PXKPTR(PXJ,PXJJ)) Q:PXJJ="" D
66 ..S PXJJJ="" F S PXJJJ=$O(PXKPTR(PXJ,PXJJ,PXJJJ)) Q:PXJJJ="" D
67 ...S PXKR=$P($T(GLOBAL^@PXKRTN),";;",2)_"("_PXJ_","_PXJJ_")"
68 ...I $D(^TMP("PXKCO",$J,PXKVST,PXKCAT,PXJ,PXJJ,"AFTER")) D
69 ....S $P(^TMP("PXKCO",$J,PXKVST,PXKCAT,PXJ,PXJJ,"AFTER"),"^",PXJJJ)=$P($G(@PXKR),"^",PXJJJ)
70 Q
71 ;
72EVENT ; EVENT TO PRESENT THE DATA TO OTHER USERS
73 Q:'$D(PXKCO("SOR"))
74 I '$D(^TMP("PXKCO",$J)) Q
75 S PXKVVST=+$O(^TMP("PXKCO",$J,0))
76 S ^TMP("PXKCO",$J,PXKVVST,"VST",PXKVVST,0,"AFTER")=$G(^AUPNVSIT(PXKVVST,0))
77 S ^TMP("PXKCO",$J,PXKVVST,"VST",PXKVVST,21,"AFTER")=$G(^AUPNVSIT(PXKVVST,21))
78 S ^TMP("PXKCO",$J,PXKVVST,"VST",PXKVVST,800,"AFTER")=$G(^AUPNVSIT(PXKVVST,800))
79 S ^TMP("PXKCO",$J,PXKVVST,"VST",PXKVVST,811,"AFTER")=$G(^AUPNVSIT(PXKVVST,811))
80 S ^TMP("PXKCO",$J,PXKVVST,"VST",PXKVVST,150,"AFTER")=$G(^AUPNVSIT(PXKVVST,150))
81 S ^TMP("PXKCO",$J,PXKVVST,"SOR",PXKCO("SOR"),0,"AFTER")=$G(^PX(839.7,PXKCO("SOR"),0))
82 S ^TMP("PXKCO",$J,PXKVVST,"SOR",PXKCO("SOR"),0,"BEFORE")=$G(^PX(839.7,PXKCO("SOR"),0))
83 S PXKOE=$O(^SCE("AVSIT",PXKVVST,"")) I PXKOE]"" S ^TMP("PXKCO",$J,PXKVVST,"OE",PXKOE,0,"BEFORE")=$G(^SCE(PXKOE,0))
84 S X=+$O(^ORD(101,"B","PXK VISIT DATA EVENT",0))_";ORD(101,"
85 ;D ENCEVENT^PXKENC(PXKVVST) ;makes the ^TMP("PXKENC",$J, array
86 D COEVENT^PXKENC(PXKVVST) ;finishes the ^TMP("PXKCO",$J array
87 D EN^XQOR
88 D FINAL^SCDXHLDR(PXKVVST,$G(PXKVST))
89UPD ;UP DATE VISIT FILE
90 ;--REMOVE CHECK OUT DATE TIME
91 N PXSWINFO S PXSWINFO=$$SWSTAT^IBBAPI()
92 N VSIT
93 I $D(PXKVVST),$D(^AUPNVSIT(PXKVVST)) S VSIT("IEN")=PXKVVST,VSIT("COD")="@" D CHKACCT D UPD^VSIT ;PX*1.0*164
94 I +PXSWINFO D
95 .I $P($G(^AUPNVSIT(PXKVVST,0)),"^",1)<$P(PXSWINFO,"^",2),$P($G(^TMP("PXKCO",$J,PXKVVST,"VST",PXKVVST,0,"BEFORE")),"^",1)<$P(PXSWINFO,"^",2) Q ;Check visit for PFSS Activation date
96 .S ^TMP("PXKCO",$J,PXKVVST,"VST",PXKVVST,0,"AFTER")=$G(^AUPNVSIT(PXKVVST,0))
97 .S X=+$O(^ORD(101,"B","PX IBB CACHE FILING EVENT",0))_";ORD(101,"
98 .D EN^XQOR
99 K ^TMP("PXKCO",$J),PXKVVST,PXKCO,VSIT
100 K ^TMP("PXKENC",$J)
101 Q
102CHKACCT ;
103 N PXSWINFO S PXSWINFO=$$SWSTAT^IBBAPI()
104 N OUTENC,PXPV1,PXPV2,SEQ,PXCPT0,PXPRV0,PXOERR,PXCPT,PXORREF,PXPROS
105 Q:'+PXSWINFO
106 Q:$P($G(^AUPNVSIT(PXKVVST,0)),"^",1)<$P(PXSWINFO,"^",2) ;Check visit for PFSS Activation date
107 Q:$P($G(^AUPNVSIT(PXKVVST,0)),"^",7)="E" ;NO ACCOUNT # FOR HISTORIC ENCOUNTERS
108 Q:$P($G(^AUPNVSIT(PXKVVST,0)),"^",7)="H" ;NO ACCOUNT # FOR HOSPTIALIZATION ENCOUNTERS
109 Q:$P($G(^AUPNVSIT(PXKVVST,812)),"^",2)=$$PKG2IEN^VSIT("RMPR") ;NO ACCOUNT # FOR PROSTHETICS
110 ;Check for existing ACT
111 S VSIT("ACT")=$P($G(^AUPNVSIT(PXKVVST,0)),"^",26) Q:VSIT("ACT")
112 ;Check Scheduling
113 I $T(GETARN^SDPFSS2)'="" S VSIT("ACT")=$$GETARN^SDPFSS2($P(^AUPNVSIT(PXKVVST,0),"^",1),$P(^AUPNVSIT(PXKVVST,0),"^",5),$P(^AUPNVSIT(PXKVVST,0),"^",22)) Q:VSIT("ACT")]0 S VSIT("ACT")=""
114 ;Check CPT codes for Lab 108, call ORWPFSS,
115 I $E($T(ORACTREF^ORWPFSS),9)="(" S PXOERR=1 D Q:PXOERR
116 .I '$D(^TMP("PXKCO",$J,PXKVVST,"CPT")) S PXOERR=0 Q ;No CPT codes, so Get Acct Ref
117 .S SEQ="" F S SEQ=$O(^TMP("PXKCO",$J,PXKVVST,"CPT",SEQ)) Q:SEQ="" D Q:'PXOERR
118 ..S PXCPT0=$G(^TMP("PXKCO",$J,PXKVVST,"CPT",SEQ,0,"AFTER"))
119 ..I $P(PXCPT0,"^",19)'=108 S PXOERR=0 Q ;Not Lab, so Get Acct Ref
120 ..I $P(PXCPT0,"^",17)="" S PXOERR=0 Q ;Lab and no Order Reference, so Get Acct Ref
121 ..I $P(PXCPT0,"^",17)'="" S PXCPT=$P(PXCPT0,"^",17) D ORACTREF^ORWPFSS(.PXORREF,.PXCPT) I PXORREF'>0 S PXOERR=0 ;Lab and no Acct Ref, so Get Acct Ref
122 ;Call Get IBBACCT
123 S PXPV1(2)=$P(^AUPNVSIT(PXKVVST,150),"^",2) S PXPV1(2)=$S(PXPV1(2)=1:"I",PXPV1(2)=0:"O",1:"") ;Inpatient, Outpatient
124 S PXPV1(3)=$P(^AUPNVSIT(PXKVVST,0),"^",22) Q:PXPV1(3)="" ;Hospital Location, Quit for Outside Locations
125 S OUTENC=$O(^SCE("AVSIT",PXKVVST,0)) I OUTENC]"" S PXPV1(4)=$P(^SCE(OUTENC,0),"^",10) ;Appointment type
126 ;Attending search
127 S PXPV1(7)=""
128 S SEQ="" F S SEQ=$O(^TMP("PXKCO",$J,PXKVVST,"PRV",SEQ)) Q:SEQ="" D Q:PXPV1(7)]""
129 .S PXPRV0=$G(^TMP("PXKCO",$J,PXKVVST,"PRV",SEQ,0,"AFTER"))
130 .I $P(PXPRV0,"^",5)="A" S PXPV1(7)=$P(PXPRV0,"^",1)
131 S PXPV1(18)=$P(^AUPNVSIT(PXKVVST,0),"^",8) ;DSS ID
132 S PXPV1(44)=$P(^AUPNVSIT(PXKVVST,0),"^",1) ;Visit D/T
133 S PXPV2(7)="" S:$P(^AUPNVSIT(PXKVVST,0),"^",21) PXPV2(7)=$P(^DIC(8,$P(^AUPNVSIT(PXKVVST,0),"^",21),0),"^",9) ;Eligibility
134 S VSIT("PAT")=$P(^AUPNVSIT(PXKVVST,0),"^",5)
135 S VSIT("ACT")=$$GETACCT^IBBAPI(VSIT("PAT"),"","A04","PXKMASC",.PXPV1,.PXPV2,,,,"","")
136 K VSIT("PAT")
Note: See TracBrowser for help on using the repository browser.