ORWPT2 ; SLC/JLC - Patient Lookup Functions (cont) ; Aug 29, 2023@11:35
;;3.0;ORDER ENTRY/RESULTS REPORTING;**485,608**;Dec 17, 1997;Build 15
;
; Reference to OUTPTPR^SDUTL3 in ICR #1252
; Reference to ^AUPNVSIT in ICR #2028
; - READ ACCESS ONLY TO PCE VISIT FILE
; covers $Ordering through "AET" index as well
; as the READing of the zero node.
; Reference to INP^VADPT in ICR #10061
; Reference to FMTE^XLFDT in ICR #10103
; Reference to GUIBS5A^DPTLK6 in ICR #3593
; Reference to STATUS^PXRMCOVID19 in ICR #7146
; Reference to GET^XPAR in ICR #2263
;
Q
;
COVID(Y,DFN) ; return COVID-19 statuses
N A,RIEN
S RIEN=+$$GET^XPAR("ALL","OR OTHER INFO REMINDER",1,"I")
I RIEN=0 S Y="-1^No Reminder definition is defined"
;ICR #7146
S Y=$$STATUS^PXRMCOVID19(DFN,RIEN)
Q Y
;
IDINFO(REC,DFN) ; Return more identifying info for a patient
; This RPC allows retrieval of the Inpatient Provider,
; Primary Care Provider, Last Location Name & Last Visit
; Date for a Patient.
;
; Input:
; DFN is the unique IEN into PATIENT file #2
; Output:
; REC which is returned as Inpatient Provider ^
; Primary Care Provider ^ Last Location Name
; ^ Last Visit Date
;
N DELETED,RECPCE,VAIN,VDT,VSTINFO
F RECPCE=1:1:4 S $P(REC,U,RECPCE)=""
D INP^VADPT I $G(VAIN(2)) S $P(REC,U,1)=$P(VAIN(2),U,2)
S $P(REC,U,2)=$P($$OUTPTPR^SDUTL3(DFN),U,2)
S VDT=""
VDTLOOP ; Loop to next previous one if this one Deleted
S VDT=$O(^AUPNVSIT("AET",DFN,VDT),-1)
I VDT]"" D G:DELETED VDTLOOP
. S DELETED=$$DELETED(DFN,VDT) Q:DELETED
. D LIST^ORQQVS(.VSTINFO,DFN,VDT,VDT,"") ; retrieve the one visit record
. I $G(VSTINFO(1))]"" D
.. S $P(REC,U,3)=$P($P(VSTINFO(1),U,3),";",2)
.. S $P(REC,U,4)=$$FMTE^XLFDT($P($P(VSTINFO(1),U,2),".",1))
Q
;
DELETED(DFN,VDT) ; Check if VISIT is Deleted
N V0,VLOC,VETYP,VIEN
S VLOC=$O(^AUPNVSIT("AET",DFN,VDT,"")) Q:VLOC="" 1
S VETYP=$O(^AUPNVSIT("AET",DFN,VDT,VLOC,"")) Q:VETYP="" 1
S VIEN=$O(^AUPNVSIT("AET",DFN,VDT,VLOC,VETYP,""))
Q:VIEN="" 1 S V0=$G(^AUPNVSIT(VIEN,0)) Q:V0="" 1
I $P(V0,U,11)=1 Q 1
Q 0
LOOKUP(ORRTN,DFN) ; Lookup not only for similar patients but include extra data
N INDX,GUICALL,RT1,RT2,RT3,NDFN
D GUIBS5A^DPTLK6(.GUICALL,DFN)
I GUICALL(1)<1 Q
M ORRTN=GUICALL
S INDX=1
F S INDX=$O(ORRTN(INDX)) Q:INDX="" D
. I $P(ORRTN(INDX),"^")'=1 Q
. S NDFN=$P(ORRTN(INDX),"^",2)
. D IDINFO^ORWPT(.RT1,NDFN)
. D IDINFO^ORWPT2(.RT2,NDFN)
. D PRCARE^ORWPT1(.RT3,NDFN)
. S $P(ORRTN(INDX),"^",6)=$P(RT1,"^",6)
. S $P(ORRTN(INDX),"^",7)=$P(RT2,"^",2)
. S $P(ORRTN(INDX),"^",8)=$P(RT2,"^",3)
. S $P(ORRTN(INDX),"^",9)=$P(RT2,"^",4)
. S $P(ORRTN(INDX),"^",10)=$P(RT3,"^",3)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWPT2 2756 printed Dec 13, 2024@02:37:13 Page 2
ORWPT2 ; SLC/JLC - Patient Lookup Functions (cont) ; Aug 29, 2023@11:35
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**485,608**;Dec 17, 1997;Build 15
+2 ;
+3 ; Reference to OUTPTPR^SDUTL3 in ICR #1252
+4 ; Reference to ^AUPNVSIT in ICR #2028
+5 ; - READ ACCESS ONLY TO PCE VISIT FILE
+6 ; covers $Ordering through "AET" index as well
+7 ; as the READing of the zero node.
+8 ; Reference to INP^VADPT in ICR #10061
+9 ; Reference to FMTE^XLFDT in ICR #10103
+10 ; Reference to GUIBS5A^DPTLK6 in ICR #3593
+11 ; Reference to STATUS^PXRMCOVID19 in ICR #7146
+12 ; Reference to GET^XPAR in ICR #2263
+13 ;
+14 QUIT
+15 ;
COVID(Y,DFN) ; return COVID-19 statuses
+1 NEW A,RIEN
+2 SET RIEN=+$$GET^XPAR("ALL","OR OTHER INFO REMINDER",1,"I")
+3 IF RIEN=0
SET Y="-1^No Reminder definition is defined"
+4 ;ICR #7146
+5 SET Y=$$STATUS^PXRMCOVID19(DFN,RIEN)
+6 QUIT Y
+7 ;
IDINFO(REC,DFN) ; Return more identifying info for a patient
+1 ; This RPC allows retrieval of the Inpatient Provider,
+2 ; Primary Care Provider, Last Location Name & Last Visit
+3 ; Date for a Patient.
+4 ;
+5 ; Input:
+6 ; DFN is the unique IEN into PATIENT file #2
+7 ; Output:
+8 ; REC which is returned as Inpatient Provider ^
+9 ; Primary Care Provider ^ Last Location Name
+10 ; ^ Last Visit Date
+11 ;
+12 NEW DELETED,RECPCE,VAIN,VDT,VSTINFO
+13 FOR RECPCE=1:1:4
SET $PIECE(REC,U,RECPCE)=""
+14 DO INP^VADPT
IF $GET(VAIN(2))
SET $PIECE(REC,U,1)=$PIECE(VAIN(2),U,2)
+15 SET $PIECE(REC,U,2)=$PIECE($$OUTPTPR^SDUTL3(DFN),U,2)
+16 SET VDT=""
VDTLOOP ; Loop to next previous one if this one Deleted
+1 SET VDT=$ORDER(^AUPNVSIT("AET",DFN,VDT),-1)
+2 IF VDT]""
Begin DoDot:1
+3 SET DELETED=$$DELETED(DFN,VDT)
if DELETED
QUIT
+4 ; retrieve the one visit record
DO LIST^ORQQVS(.VSTINFO,DFN,VDT,VDT,"")
+5 IF $GET(VSTINFO(1))]""
Begin DoDot:2
+6 SET $PIECE(REC,U,3)=$PIECE($PIECE(VSTINFO(1),U,3),";",2)
+7 SET $PIECE(REC,U,4)=$$FMTE^XLFDT($PIECE($PIECE(VSTINFO(1),U,2),".",1))
End DoDot:2
End DoDot:1
if DELETED
GOTO VDTLOOP
+8 QUIT
+9 ;
DELETED(DFN,VDT) ; Check if VISIT is Deleted
+1 NEW V0,VLOC,VETYP,VIEN
+2 SET VLOC=$ORDER(^AUPNVSIT("AET",DFN,VDT,""))
if VLOC=""
QUIT 1
+3 SET VETYP=$ORDER(^AUPNVSIT("AET",DFN,VDT,VLOC,""))
if VETYP=""
QUIT 1
+4 SET VIEN=$ORDER(^AUPNVSIT("AET",DFN,VDT,VLOC,VETYP,""))
+5 if VIEN=""
QUIT 1
SET V0=$GET(^AUPNVSIT(VIEN,0))
if V0=""
QUIT 1
+6 IF $PIECE(V0,U,11)=1
QUIT 1
+7 QUIT 0
LOOKUP(ORRTN,DFN) ; Lookup not only for similar patients but include extra data
+1 NEW INDX,GUICALL,RT1,RT2,RT3,NDFN
+2 DO GUIBS5A^DPTLK6(.GUICALL,DFN)
+3 IF GUICALL(1)<1
QUIT
+4 MERGE ORRTN=GUICALL
+5 SET INDX=1
+6 FOR
SET INDX=$ORDER(ORRTN(INDX))
if INDX=""
QUIT
Begin DoDot:1
+7 IF $PIECE(ORRTN(INDX),"^")'=1
QUIT
+8 SET NDFN=$PIECE(ORRTN(INDX),"^",2)
+9 DO IDINFO^ORWPT(.RT1,NDFN)
+10 DO IDINFO^ORWPT2(.RT2,NDFN)
+11 DO PRCARE^ORWPT1(.RT3,NDFN)
+12 SET $PIECE(ORRTN(INDX),"^",6)=$PIECE(RT1,"^",6)
+13 SET $PIECE(ORRTN(INDX),"^",7)=$PIECE(RT2,"^",2)
+14 SET $PIECE(ORRTN(INDX),"^",8)=$PIECE(RT2,"^",3)
+15 SET $PIECE(ORRTN(INDX),"^",9)=$PIECE(RT2,"^",4)
+16 SET $PIECE(ORRTN(INDX),"^",10)=$PIECE(RT3,"^",3)
End DoDot:1
+17 QUIT
