ORWPFSS4 ;SLC-GDU CPRS HL7 PROCESSING FOR RAD PRE-CERT;[08/29/05];
;;3.0;ORDER ENTRY/RESULTS REPORTING;**228**;Dec 17, 1997
;Determine if the order is to have an PFSS Account Reference
;associated with it. This is for orders that are not event delayed
;
;DBIA References for external calls
; $$GETS^DIQ - DBIA 2056
; $$GETS1^DIQ - DBIA 2056
; $$PKGTYP^ORWPFSS - Internal to CPRS PFSS
; PFSSACTV^ORWPFSS - Internal to CPRS PFSS
; $$ACCTREF^ORWPFSS1 - Internal to CPRS PFSS
; $$GETARN^SDPFSS2 - DBIA 4668
; INP^VADPT - DBIA 10061
; ^VSIT - DBIA 1900-A
;
EN(ORIEN) ;Primary entry point of this routine
;Input Variable
; ORIEN The Order Internal Entry Number
;Local Variables
; ORAR Order Account Reference (PFSS AR)
; ORDFN Order Patient's DFN (IEN)
; ORPFSS Order PFSS Active Indicator
; ORUPDT Order Update Indicator from record update
; ORVS Order Visit String
;
N ORAR,ORDFN,ORPFSS,ORUPDT,ORVS,X,Y
S (ORAR,ORPFSS)=""
;If PFSS is inactive goto exit
D PFSSACTV^ORWPFSS(.ORPFSS) I ORPFSS=0 G EXIT
;If Order already has PFSS Account Reference goto exit
S ORAR=$$GET1^DIQ(100,ORIEN,97) I ORAR'="" G EXIT
;If Order package is not one of the currently supported goto exit
I $$PKGTYP^ORWPFSS(ORIEN)=0 G EXIT
;If Visit String not found goto EXIT.
S ORVS=$$GETVS(ORIEN) I ORVS="" G EXIT
;Get Patient's DFN from the Order
S ORDFN=+$$GET1^DIQ(100,ORIEN,.02,"I")
;If Historical set PFSS Account Reference to null and goto Save
I $P(ORVS,";",3)="E" S ORAR="" G SAVE
;If Scheduled Appointment get PFSS Account Reference and goto Save
I $P(ORVS,";",3)="A" S ORAR=$$SAAR(ORVS,ORDFN) I ORAR'="" G SAVE
;If Hospital Admission get PFSS Account Reference and goto Save
I $P(ORVS,";",3)="H" S ORAR=$$HAAR(ORDFN) I ORAR'="" G SAVE
;Check PCE for PFSS Account Reference
S ORAR=$$PCEAR(ORVS,ORDFN)
SAVE ;Save PFSS Account Reference or null value to the Order record
S ORUPDT=$$ACCTREF^ORWPFSS1(ORIEN,ORAR)
EXIT ;Exit point for this routine
Q
GETVS(X1) ;Get Order Visit String
;Get the data from the Order's Responses multi-valued field.
;Look for Prompt text of OR GTX VISITSTR
;If Prompt text found get the Visit String
;If Prompt text not found return a null value
;Input variable required, if missing this will return a null value
;Input Variable for this function
; X1 The Order IEN
;Return Variable for this function
; VS The Order Visit String
;Local Variable for this function
; IENS Index variable for REC array
; PT Prompt Text being searched for
; REC Output variable for GETS^DIQ that will contain the Order
; Responses data.
N IENS,PT,REC,VS
I X1="" S VS="" Q VS
S (IENS,VS)=""
S PT=$P($T(VSPT),";",3)
D GETS^DIQ(100,X1,"4.5*","E","REC")
F S IENS=$O(REC(100.045,IENS)) Q:IENS="" D
. I $G(REC(100.045,IENS,.02,"E"))=PT S VS=$G(REC(100.045,IENS,1,"E"))
Q VS
VSPT ;Visit String Prompt Text;OR GTX VISITSTR
;
SAAR(X1,X2) ;Scheduled Appointment Account Reference for PFSS
;Get the PFSS Account Reference for scheduled appointments
;All inputs required, any missing this will return a null value
;Input Variables
; X1 The Visit String from the Order
; X2 The Patient's IEN
;Output Variable
; AR PFSS Account Reference returned by $$GETARN^SDPFSS2
; Set to null in any input is missing
;
N AR
I X1=""!(X2="") S AR="" Q AR
;Get the PFSS Account Reference from Scheduling
S AR=+$$GETARN^SDPFSS2($P(X1,";",2),X2,$P(X1,";"))
I AR>0 Q AR ;If found return Account Reference
S AR="" Q AR ;If not found return null for Account Reference
;
HAAR(X1) ;Hospital Admission Account Reference for PFSS
;Returns the PFSS Account Reference for the Hospital Admission
;Input is required. If missing null value returned.
;Returns PFSS Account Reference returned if found.
;Returns null if PFSS Account Reference not found null.
;Input Variable for this function
; X1 The Patient's DFN
;Output Variables for this function
; ER Set to null and returned if missing input
; VAIN("NR") The node of VAIN that contains the PFSS Account Reference
;Internal Variables for this function
; DFN VADPT input variable, Patient's record number
; VAHOW VADPT input variable, sends output to array variable VAIN
; VAIN Output array variable with results of INP^VAIN
;
N ER,DFN,VAHOW,VAIN
I X1="" S ER="" Q ER
S DFN=X1
S VAHOW=1
D INP^VADPT
Q $G(VAIN("NR"))
;
PCEAR(X1,X2) ;PCE Account Reference for PFSS
;Returns the PFSS Account Reference from PCE
;All input required, if any missing this will a null.
;Returns PFSS Account Reference returned if found.
;Returns null if PFSS Account Reference not found null.
;Input Variable for this function
; X1 The Visit String from the Order
; X2 The Patient's IEN
; VSIT The input and output array variable for ^VSIT
;Output Variables for this function
; ER Set to null and returned if missing input
; VSIT("ACT") The node of array variable VSIT that contains
; the PFSS Account Reference returned by ^VSIT
;Local Variable for this function
; VSIT The input and output array variable for ^VSIT
;
N ER,VSIT
I X1=""!(X2="") S ER="" Q ER
S VSIT(0)="D0EM"
S VSIT("VDT")=$P(X1,";",2)
S VSIT("LOC")=$P(X1,";")
S VSIT("PKG")="OR"
S VSIT("PAT")=X2
D ^VSIT
I $G(VSIT("IEN"))<0 S ER="" Q ER
Q $G(VSIT("ACT"))
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWPFSS4 5501 printed Sep 23, 2025@20:13:26 Page 2
ORWPFSS4 ;SLC-GDU CPRS HL7 PROCESSING FOR RAD PRE-CERT;[08/29/05];
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**228**;Dec 17, 1997
+2 ;Determine if the order is to have an PFSS Account Reference
+3 ;associated with it. This is for orders that are not event delayed
+4 ;
+5 ;DBIA References for external calls
+6 ; $$GETS^DIQ - DBIA 2056
+7 ; $$GETS1^DIQ - DBIA 2056
+8 ; $$PKGTYP^ORWPFSS - Internal to CPRS PFSS
+9 ; PFSSACTV^ORWPFSS - Internal to CPRS PFSS
+10 ; $$ACCTREF^ORWPFSS1 - Internal to CPRS PFSS
+11 ; $$GETARN^SDPFSS2 - DBIA 4668
+12 ; INP^VADPT - DBIA 10061
+13 ; ^VSIT - DBIA 1900-A
+14 ;
EN(ORIEN) ;Primary entry point of this routine
+1 ;Input Variable
+2 ; ORIEN The Order Internal Entry Number
+3 ;Local Variables
+4 ; ORAR Order Account Reference (PFSS AR)
+5 ; ORDFN Order Patient's DFN (IEN)
+6 ; ORPFSS Order PFSS Active Indicator
+7 ; ORUPDT Order Update Indicator from record update
+8 ; ORVS Order Visit String
+9 ;
+10 NEW ORAR,ORDFN,ORPFSS,ORUPDT,ORVS,X,Y
+11 SET (ORAR,ORPFSS)=""
+12 ;If PFSS is inactive goto exit
+13 DO PFSSACTV^ORWPFSS(.ORPFSS)
IF ORPFSS=0
GOTO EXIT
+14 ;If Order already has PFSS Account Reference goto exit
+15 SET ORAR=$$GET1^DIQ(100,ORIEN,97)
IF ORAR'=""
GOTO EXIT
+16 ;If Order package is not one of the currently supported goto exit
+17 IF $$PKGTYP^ORWPFSS(ORIEN)=0
GOTO EXIT
+18 ;If Visit String not found goto EXIT.
+19 SET ORVS=$$GETVS(ORIEN)
IF ORVS=""
GOTO EXIT
+20 ;Get Patient's DFN from the Order
+21 SET ORDFN=+$$GET1^DIQ(100,ORIEN,.02,"I")
+22 ;If Historical set PFSS Account Reference to null and goto Save
+23 IF $PIECE(ORVS,";",3)="E"
SET ORAR=""
GOTO SAVE
+24 ;If Scheduled Appointment get PFSS Account Reference and goto Save
+25 IF $PIECE(ORVS,";",3)="A"
SET ORAR=$$SAAR(ORVS,ORDFN)
IF ORAR'=""
GOTO SAVE
+26 ;If Hospital Admission get PFSS Account Reference and goto Save
+27 IF $PIECE(ORVS,";",3)="H"
SET ORAR=$$HAAR(ORDFN)
IF ORAR'=""
GOTO SAVE
+28 ;Check PCE for PFSS Account Reference
+29 SET ORAR=$$PCEAR(ORVS,ORDFN)
SAVE ;Save PFSS Account Reference or null value to the Order record
+1 SET ORUPDT=$$ACCTREF^ORWPFSS1(ORIEN,ORAR)
EXIT ;Exit point for this routine
+1 QUIT
GETVS(X1) ;Get Order Visit String
+1 ;Get the data from the Order's Responses multi-valued field.
+2 ;Look for Prompt text of OR GTX VISITSTR
+3 ;If Prompt text found get the Visit String
+4 ;If Prompt text not found return a null value
+5 ;Input variable required, if missing this will return a null value
+6 ;Input Variable for this function
+7 ; X1 The Order IEN
+8 ;Return Variable for this function
+9 ; VS The Order Visit String
+10 ;Local Variable for this function
+11 ; IENS Index variable for REC array
+12 ; PT Prompt Text being searched for
+13 ; REC Output variable for GETS^DIQ that will contain the Order
+14 ; Responses data.
+15 NEW IENS,PT,REC,VS
+16 IF X1=""
SET VS=""
QUIT VS
+17 SET (IENS,VS)=""
+18 SET PT=$PIECE($TEXT(VSPT),";",3)
+19 DO GETS^DIQ(100,X1,"4.5*","E","REC")
+20 FOR
SET IENS=$ORDER(REC(100.045,IENS))
if IENS=""
QUIT
Begin DoDot:1
+21 IF $GET(REC(100.045,IENS,.02,"E"))=PT
SET VS=$GET(REC(100.045,IENS,1,"E"))
End DoDot:1
+22 QUIT VS
VSPT ;Visit String Prompt Text;OR GTX VISITSTR
+1 ;
SAAR(X1,X2) ;Scheduled Appointment Account Reference for PFSS
+1 ;Get the PFSS Account Reference for scheduled appointments
+2 ;All inputs required, any missing this will return a null value
+3 ;Input Variables
+4 ; X1 The Visit String from the Order
+5 ; X2 The Patient's IEN
+6 ;Output Variable
+7 ; AR PFSS Account Reference returned by $$GETARN^SDPFSS2
+8 ; Set to null in any input is missing
+9 ;
+10 NEW AR
+11 IF X1=""!(X2="")
SET AR=""
QUIT AR
+12 ;Get the PFSS Account Reference from Scheduling
+13 SET AR=+$$GETARN^SDPFSS2($PIECE(X1,";",2),X2,$PIECE(X1,";"))
+14 ;If found return Account Reference
IF AR>0
QUIT AR
+15 ;If not found return null for Account Reference
SET AR=""
QUIT AR
+16 ;
HAAR(X1) ;Hospital Admission Account Reference for PFSS
+1 ;Returns the PFSS Account Reference for the Hospital Admission
+2 ;Input is required. If missing null value returned.
+3 ;Returns PFSS Account Reference returned if found.
+4 ;Returns null if PFSS Account Reference not found null.
+5 ;Input Variable for this function
+6 ; X1 The Patient's DFN
+7 ;Output Variables for this function
+8 ; ER Set to null and returned if missing input
+9 ; VAIN("NR") The node of VAIN that contains the PFSS Account Reference
+10 ;Internal Variables for this function
+11 ; DFN VADPT input variable, Patient's record number
+12 ; VAHOW VADPT input variable, sends output to array variable VAIN
+13 ; VAIN Output array variable with results of INP^VAIN
+14 ;
+15 NEW ER,DFN,VAHOW,VAIN
+16 IF X1=""
SET ER=""
QUIT ER
+17 SET DFN=X1
+18 SET VAHOW=1
+19 DO INP^VADPT
+20 QUIT $GET(VAIN("NR"))
+21 ;
PCEAR(X1,X2) ;PCE Account Reference for PFSS
+1 ;Returns the PFSS Account Reference from PCE
+2 ;All input required, if any missing this will a null.
+3 ;Returns PFSS Account Reference returned if found.
+4 ;Returns null if PFSS Account Reference not found null.
+5 ;Input Variable for this function
+6 ; X1 The Visit String from the Order
+7 ; X2 The Patient's IEN
+8 ; VSIT The input and output array variable for ^VSIT
+9 ;Output Variables for this function
+10 ; ER Set to null and returned if missing input
+11 ; VSIT("ACT") The node of array variable VSIT that contains
+12 ; the PFSS Account Reference returned by ^VSIT
+13 ;Local Variable for this function
+14 ; VSIT The input and output array variable for ^VSIT
+15 ;
+16 NEW ER,VSIT
+17 IF X1=""!(X2="")
SET ER=""
QUIT ER
+18 SET VSIT(0)="D0EM"
+19 SET VSIT("VDT")=$PIECE(X1,";",2)
+20 SET VSIT("LOC")=$PIECE(X1,";")
+21 SET VSIT("PKG")="OR"
+22 SET VSIT("PAT")=X2
+23 DO ^VSIT
+24 IF $GET(VSIT("IEN"))<0
SET ER=""
QUIT ER
+25 QUIT $GET(VSIT("ACT"))
