ORWPCE1 ;ISL/KCM,JER - PCE Calls from CPRS GUI ;Feb 12, 2024@14:45
;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,116,132,148,187,190,215,243,280,306,361,501,559,405,598,606**;Dec 17, 1997;Build 3
;
; Reference to DSELECT^GMPLENFM, ^TMP("IB",$J) in ICR #1365
; Reference to $$DATA2PCE^PXAPI in ICR #1893
; Reference to $$DELVFILE^PXAPI in ICR #1890
; Reference to DQSAVE^PXRPC in ICR #6023
; Reference to $$NOW^XLFDT in ICR #5747
; Reference to FILE^TIUSRVP in ICR #3540
; Reference to $$ISADDNDM^TIULC1 in ICR #2323
; Reference to FINDVISIT^PXUTLVST in ICR #7435
; Reference to ^TIU(8925, in ICR #2937
; Reference to ^AUPNVSIT( in ICR #2028
;
GETVSIT(VSTR,DFN) ; lookup a visit
; Return Visit IEN if there is a Visit that matches the input; otherwise return 0.
N ORDTE,ORLOC,ORSVC,ORVISIT,ORVISITLIST
S ORVISIT=0
I '$G(DFN)!($G(VSTR)="") Q ORVISIT
;
S ORLOC=$P(VSTR,";")
S ORDTE=$P(VSTR,";",2)
S ORSVC=$P(VSTR,";",3)
D FINDVISIT^PXUTLVST(DFN,ORDTE,ORLOC,ORSVC,"","","","",1,.ORVISITLIST)
I $G(ORVISITLIST(0))>0 S ORVISIT=$G(ORVISITLIST(1))
;
Q ORVISIT
;
DQSAVE(ORRESULT,PCELIST,NOTEIEN,GMPLUSER,ORLOC) ; Background Call to DATA2PCE IA#6443
I $D(ZTQUEUED) S ZTREQ="@"
N PKG,PKGNAME,ORPXAPI,ORPCELST,ORPROBLS,ORPXDEL,PKGNAME,PROBLEM,PXAPREDT,PXNODE,PXVSTR,SRC,X,ORAVST,ORPXIMMRD,OK
N DFN,ERRARR,ERRPROB
S ORAVST=$P($G(PCELIST(1)),U,5) I +ORAVST S $P(PCELIST(1),U,5)=""
I +ORAVST>0 D
.S PXNODE=$G(^AUPNVSIT(ORAVST,0))
.S PXVSTR=$P(PXNODE,U,6)_";"_$P(PXNODE,U)_";"_$P(PXNODE,U,7)
.I $P(PXNODE,U,7)'="H" Q
.I PXVSTR'=$P($G(PCELIST(1)),U,4) S ORAVST=-1
I +ORAVST<1 S ORAVST=""
S PKGNAME="ORDER ENTRY/RESULTS REPORTING"
S PKG=$O(^DIC(9.4,"B","ORDER ENTRY/RESULTS REPORTING",0))
S SRC="TEXT INTEGRATION UTILITIES"
M ORPCELST=PCELIST
S ORRESULT(0)=1
D DQSAVE^PXRPC(.ORPCELST,.ORPXAPI,.ORPROBLS,.SRC,.ORPXIMMRD)
S DFN=ORPXAPI("ENCOUNTER",1,"PATIENT")
S PXAPREDT=0
I $D(ORPXAPI("PROVIDER")) S PXAPREDT=1
D DQSAVE1
Q
;
DQSAVE1 ;
;Remove any problems to add that the patient already has as active problems
I $D(ORPROBLS),$D(DFN) D
. N ORWPROB,ORPROBIX
. K ^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS")
. D DSELECT^GMPLENFM ;DBIA 1365
. S ORPROBIX=0
. F S ORPROBIX=$O(^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",ORPROBIX)) Q:'ORPROBIX D ;DBIA 1365
.. S ORWPROB=$P(^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",ORPROBIX),"^",2,3)
.. S ORWPROB($S($E(ORWPROB,1)="$":$E(ORWPROB,2,255),1:ORWPROB))=""
. K ^TMP("IB",$J,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS")
. Q:'$D(ORWPROB)
. S ORPROBIX=""
. F S ORPROBIX=$O(ORPROBLS(ORPROBIX)) Q:'ORPROBIX D
.. S:$D(ORWPROB(ORPROBLS(ORPROBIX))) ORPXAPI("DX/PL",ORPROBIX,"PL ADD")=0
;
I $$MDS(.ORPXAPI,$G(ORLOC)) D
.N ORTIME
.S ORTIME=$$NOW^XLFDT
.S ORPXAPI("ENCOUNTER",1,"CHECKOUT D/T")=ORTIME
DATA2PCE ;
N TIEN,VISITOK,X0,X12
S OK=$$DATA2PCE^PXAPI("ORPXAPI",PKG,SRC,.ORAVST,DUZ,0,.ERRARR,PXAPREDT,.ERRPROB)
S VISITOK=$S(OK=1:1,(OK=-1)&(+ORAVST>0):1,(OK=-5)&(+ORAVST>0):1,1:0)
I OK<0,OK'=-5 D ERROR(.ORRESULT,.ERRARR,.ERRPROB) ;S ORRESULT(0)=OK
S ORRESULT(0)=$S(VISITOK=1:1,1:OK)
S $P(ORRESULT(0),U,2)=ORAVST
;NOTEIEN only set on inpatient encounters.
I VISITOK,+NOTEIEN,$P($G(^TIU(8925,+NOTEIEN,0)),U,13)="H" D
.N OROK,ORX
.S ORX(1207)=ORAVST
.D FILE^TIUSRVP(.OROK,NOTEIEN,.ORX,1)
.I '$$ISADDNDM^TIULC1(NOTEIEN) Q
.S X0=$G(^TIU(8925,NOTEIEN,0))
.I +$P(X0,U,6)>0 D
..S TIEN=+$P(X0,U,6)
..S X12=$G(^TIU(8925,TIEN,12))
..I $P(X12,U,7)>0 Q
..S ORX(1207)=ORAVST
..D FILE^TIUSRVP(.OROK,TIEN,.ORX,1)
.I OROK'=1 S ORCNT=1+$O(ORRESULT("?"),-1),ORRESULT(ORCNT)=$P(OROK,U,2)
S ZTSTAT=0 ; clear sync flag
;.N OROK,ORCNT
;.D LNKSVST^TIUPXAP3(.OROK,DFN,NOTEIEN,ORAVST)
;I OROK'=1 S ORCNT=1+$O(RESULT("?"),-1),RESULT(ORCNT)=$P(OROK,U,2)
; Save imm smallpox reading.
; Need separate DATA2PCE call, as it is tied to a different Visit.
I $D(ORPXIMMRD) D
. N CNT,ORERROR,ORVISIT,OK,ERRARR,ERRPROB
. S ORERROR=$G(ORPXIMMRD("IMMUNIZATION",1,"ERROR"))
. S ORVISIT=$G(ORPXIMMRD("IMMUNIZATION",1,"VISIT"))
. K ORPXIMMRD("IMMUNIZATION",1,"ERROR"),ORPXIMMRD("IMMUNIZATION",1,"VISIT")
. I ORERROR'="" D Q
. . S CNT=+$O(ORRESULT(""),-1)
. . S CNT=CNT+1
. . S ORRESULT(CNT)=" "
. . S CNT=CNT+1
. . S ORRESULT(CNT)=ORERROR
. I 'ORVISIT Q
. S OK=$$DATA2PCE^PXAPI("ORPXIMMRD",PKG,SRC,.ORVISIT,DUZ,0,.ERRARR,"",.ERRPROB)
. I OK<0,OK'=-5 D
. . S CNT=+$O(ORRESULT(""),-1)
. . S CNT=CNT+1
. . S ORRESULT(CNT)=" "
. . D ERROR(.ORRESULT,.ERRARR,.ERRPROB)
. . I +$G(ORRESULT(0))>0 S $P(ORRESULT(0),U,1)=OK
;
Q
;
ERROR(ORRESULT,ERRARR,ERRPROB) ;
N CNT,IDX,MSG
S CNT=+$O(ORRESULT(""),-1)
I $D(ERRARR) D
.D ACOPY^ORERRH("ERRARR","MSG()")
.S IDX=0 F S IDX=$O(MSG(IDX)) Q:IDX'>0 S CNT=CNT+1,ORRESULT(CNT)=$P(MSG(IDX),"=",2,10)
K OUTPUT
I $D(ERRPROB),'$D(ERRARR) D
.D ACOPY^ORERRH("ERRPROB","MSG()")
.S IDX=0 F S IDX=$O(MSG(IDX)) Q:IDX'>0 S CNT=CNT+1,ORRESULT(CNT)=$P(MSG(IDX),"=",2,10)
Q
;
MDS(X,ORLOC) ; return TRUE if checkout is needed
I $$CHKOUT^ORWPCE2(ORLOC) Q 1
N I,ORAUTO,OROK
S (OROK,I)=0
F S I=$O(X("DX/PL",I)) Q:'I D Q:OROK
. I $G(X("DX/PL",I,"DIAGNOSIS")) S OROK=1
I 'OROK D
.S I=0 F S I=$O(X("PROCEDURE",I)) Q:'I D Q:OROK
.. I $G(X("PROCEDURE",I,"PROCEDURE")) S OROK=1
I $D(X("PROVIDER",1,"NAME")) S OROK=1
Q OROK
NONCOUNT(ORY,ORLOC) ; Is the location a non-count clinic? (DBIA #964)
Q:'ORLOC
S ORY=$S($P($G(^SC(ORLOC,0)),U,17)="Y":1,1:0)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWPCE1 5602 printed Sep 23, 2025@20:13:17 Page 2
ORWPCE1 ;ISL/KCM,JER - PCE Calls from CPRS GUI ;Feb 12, 2024@14:45
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,116,132,148,187,190,215,243,280,306,361,501,559,405,598,606**;Dec 17, 1997;Build 3
+2 ;
+3 ; Reference to DSELECT^GMPLENFM, ^TMP("IB",$J) in ICR #1365
+4 ; Reference to $$DATA2PCE^PXAPI in ICR #1893
+5 ; Reference to $$DELVFILE^PXAPI in ICR #1890
+6 ; Reference to DQSAVE^PXRPC in ICR #6023
+7 ; Reference to $$NOW^XLFDT in ICR #5747
+8 ; Reference to FILE^TIUSRVP in ICR #3540
+9 ; Reference to $$ISADDNDM^TIULC1 in ICR #2323
+10 ; Reference to FINDVISIT^PXUTLVST in ICR #7435
+11 ; Reference to ^TIU(8925, in ICR #2937
+12 ; Reference to ^AUPNVSIT( in ICR #2028
+13 ;
GETVSIT(VSTR,DFN) ; lookup a visit
+1 ; Return Visit IEN if there is a Visit that matches the input; otherwise return 0.
+2 NEW ORDTE,ORLOC,ORSVC,ORVISIT,ORVISITLIST
+3 SET ORVISIT=0
+4 IF '$GET(DFN)!($GET(VSTR)="")
QUIT ORVISIT
+5 ;
+6 SET ORLOC=$PIECE(VSTR,";")
+7 SET ORDTE=$PIECE(VSTR,";",2)
+8 SET ORSVC=$PIECE(VSTR,";",3)
+9 DO FINDVISIT^PXUTLVST(DFN,ORDTE,ORLOC,ORSVC,"","","","",1,.ORVISITLIST)
+10 IF $GET(ORVISITLIST(0))>0
SET ORVISIT=$GET(ORVISITLIST(1))
+11 ;
+12 QUIT ORVISIT
+13 ;
DQSAVE(ORRESULT,PCELIST,NOTEIEN,GMPLUSER,ORLOC) ; Background Call to DATA2PCE IA#6443
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 NEW PKG,PKGNAME,ORPXAPI,ORPCELST,ORPROBLS,ORPXDEL,PKGNAME,PROBLEM,PXAPREDT,PXNODE,PXVSTR,SRC,X,ORAVST,ORPXIMMRD,OK
+3 NEW DFN,ERRARR,ERRPROB
+4 SET ORAVST=$PIECE($GET(PCELIST(1)),U,5)
IF +ORAVST
SET $PIECE(PCELIST(1),U,5)=""
+5 IF +ORAVST>0
Begin DoDot:1
+6 SET PXNODE=$GET(^AUPNVSIT(ORAVST,0))
+7 SET PXVSTR=$PIECE(PXNODE,U,6)_";"_$PIECE(PXNODE,U)_";"_$PIECE(PXNODE,U,7)
+8 IF $PIECE(PXNODE,U,7)'="H"
QUIT
+9 IF PXVSTR'=$PIECE($GET(PCELIST(1)),U,4)
SET ORAVST=-1
End DoDot:1
+10 IF +ORAVST<1
SET ORAVST=""
+11 SET PKGNAME="ORDER ENTRY/RESULTS REPORTING"
+12 SET PKG=$ORDER(^DIC(9.4,"B","ORDER ENTRY/RESULTS REPORTING",0))
+13 SET SRC="TEXT INTEGRATION UTILITIES"
+14 MERGE ORPCELST=PCELIST
+15 SET ORRESULT(0)=1
+16 DO DQSAVE^PXRPC(.ORPCELST,.ORPXAPI,.ORPROBLS,.SRC,.ORPXIMMRD)
+17 SET DFN=ORPXAPI("ENCOUNTER",1,"PATIENT")
+18 SET PXAPREDT=0
+19 IF $DATA(ORPXAPI("PROVIDER"))
SET PXAPREDT=1
+20 DO DQSAVE1
+21 QUIT
+22 ;
DQSAVE1 ;
+1 ;Remove any problems to add that the patient already has as active problems
+2 IF $DATA(ORPROBLS)
IF $DATA(DFN)
Begin DoDot:1
+3 NEW ORWPROB,ORPROBIX
+4 KILL ^TMP("IB",$JOB,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS")
+5 ;DBIA 1365
DO DSELECT^GMPLENFM
+6 SET ORPROBIX=0
+7 ;DBIA 1365
FOR
SET ORPROBIX=$ORDER(^TMP("IB",$JOB,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",ORPROBIX))
if 'ORPROBIX
QUIT
Begin DoDot:2
+8 SET ORWPROB=$PIECE(^TMP("IB",$JOB,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",ORPROBIX),"^",2,3)
+9 SET ORWPROB($SELECT($EXTRACT(ORWPROB,1)="$":$EXTRACT(ORWPROB,2,255),1:ORWPROB))=""
End DoDot:2
+10 KILL ^TMP("IB",$JOB,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS")
+11 if '$DATA(ORWPROB)
QUIT
+12 SET ORPROBIX=""
+13 FOR
SET ORPROBIX=$ORDER(ORPROBLS(ORPROBIX))
if 'ORPROBIX
QUIT
Begin DoDot:2
+14 if $DATA(ORWPROB(ORPROBLS(ORPROBIX)))
SET ORPXAPI("DX/PL",ORPROBIX,"PL ADD")=0
End DoDot:2
End DoDot:1
+15 ;
+16 IF $$MDS(.ORPXAPI,$GET(ORLOC))
Begin DoDot:1
+17 NEW ORTIME
+18 SET ORTIME=$$NOW^XLFDT
+19 SET ORPXAPI("ENCOUNTER",1,"CHECKOUT D/T")=ORTIME
End DoDot:1
DATA2PCE ;
+1 NEW TIEN,VISITOK,X0,X12
+2 SET OK=$$DATA2PCE^PXAPI("ORPXAPI",PKG,SRC,.ORAVST,DUZ,0,.ERRARR,PXAPREDT,.ERRPROB)
+3 SET VISITOK=$SELECT(OK=1:1,(OK=-1)&(+ORAVST>0):1,(OK=-5)&(+ORAVST>0):1,1:0)
+4 ;S ORRESULT(0)=OK
IF OK<0
IF OK'=-5
DO ERROR(.ORRESULT,.ERRARR,.ERRPROB)
+5 SET ORRESULT(0)=$SELECT(VISITOK=1:1,1:OK)
+6 SET $PIECE(ORRESULT(0),U,2)=ORAVST
+7 ;NOTEIEN only set on inpatient encounters.
+8 IF VISITOK
IF +NOTEIEN
IF $PIECE($GET(^TIU(8925,+NOTEIEN,0)),U,13)="H"
Begin DoDot:1
+9 NEW OROK,ORX
+10 SET ORX(1207)=ORAVST
+11 DO FILE^TIUSRVP(.OROK,NOTEIEN,.ORX,1)
+12 IF '$$ISADDNDM^TIULC1(NOTEIEN)
QUIT
+13 SET X0=$GET(^TIU(8925,NOTEIEN,0))
+14 IF +$PIECE(X0,U,6)>0
Begin DoDot:2
+15 SET TIEN=+$PIECE(X0,U,6)
+16 SET X12=$GET(^TIU(8925,TIEN,12))
+17 IF $PIECE(X12,U,7)>0
QUIT
+18 SET ORX(1207)=ORAVST
+19 DO FILE^TIUSRVP(.OROK,TIEN,.ORX,1)
End DoDot:2
+20 IF OROK'=1
SET ORCNT=1+$ORDER(ORRESULT("?"),-1)
SET ORRESULT(ORCNT)=$PIECE(OROK,U,2)
End DoDot:1
+21 ; clear sync flag
SET ZTSTAT=0
+22 ;.N OROK,ORCNT
+23 ;.D LNKSVST^TIUPXAP3(.OROK,DFN,NOTEIEN,ORAVST)
+24 ;I OROK'=1 S ORCNT=1+$O(RESULT("?"),-1),RESULT(ORCNT)=$P(OROK,U,2)
+25 ; Save imm smallpox reading.
+26 ; Need separate DATA2PCE call, as it is tied to a different Visit.
+27 IF $DATA(ORPXIMMRD)
Begin DoDot:1
+28 NEW CNT,ORERROR,ORVISIT,OK,ERRARR,ERRPROB
+29 SET ORERROR=$GET(ORPXIMMRD("IMMUNIZATION",1,"ERROR"))
+30 SET ORVISIT=$GET(ORPXIMMRD("IMMUNIZATION",1,"VISIT"))
+31 KILL ORPXIMMRD("IMMUNIZATION",1,"ERROR"),ORPXIMMRD("IMMUNIZATION",1,"VISIT")
+32 IF ORERROR'=""
Begin DoDot:2
+33 SET CNT=+$ORDER(ORRESULT(""),-1)
+34 SET CNT=CNT+1
+35 SET ORRESULT(CNT)=" "
+36 SET CNT=CNT+1
+37 SET ORRESULT(CNT)=ORERROR
End DoDot:2
QUIT
+38 IF 'ORVISIT
QUIT
+39 SET OK=$$DATA2PCE^PXAPI("ORPXIMMRD",PKG,SRC,.ORVISIT,DUZ,0,.ERRARR,"",.ERRPROB)
+40 IF OK<0
IF OK'=-5
Begin DoDot:2
+41 SET CNT=+$ORDER(ORRESULT(""),-1)
+42 SET CNT=CNT+1
+43 SET ORRESULT(CNT)=" "
+44 DO ERROR(.ORRESULT,.ERRARR,.ERRPROB)
+45 IF +$GET(ORRESULT(0))>0
SET $PIECE(ORRESULT(0),U,1)=OK
End DoDot:2
End DoDot:1
+46 ;
+47 QUIT
+48 ;
ERROR(ORRESULT,ERRARR,ERRPROB) ;
+1 NEW CNT,IDX,MSG
+2 SET CNT=+$ORDER(ORRESULT(""),-1)
+3 IF $DATA(ERRARR)
Begin DoDot:1
+4 DO ACOPY^ORERRH("ERRARR","MSG()")
+5 SET IDX=0
FOR
SET IDX=$ORDER(MSG(IDX))
if IDX'>0
QUIT
SET CNT=CNT+1
SET ORRESULT(CNT)=$PIECE(MSG(IDX),"=",2,10)
End DoDot:1
+6 KILL OUTPUT
+7 IF $DATA(ERRPROB)
IF '$DATA(ERRARR)
Begin DoDot:1
+8 DO ACOPY^ORERRH("ERRPROB","MSG()")
+9 SET IDX=0
FOR
SET IDX=$ORDER(MSG(IDX))
if IDX'>0
QUIT
SET CNT=CNT+1
SET ORRESULT(CNT)=$PIECE(MSG(IDX),"=",2,10)
End DoDot:1
+10 QUIT
+11 ;
MDS(X,ORLOC) ; return TRUE if checkout is needed
+1 IF $$CHKOUT^ORWPCE2(ORLOC)
QUIT 1
+2 NEW I,ORAUTO,OROK
+3 SET (OROK,I)=0
+4 FOR
SET I=$ORDER(X("DX/PL",I))
if 'I
QUIT
Begin DoDot:1
+5 IF $GET(X("DX/PL",I,"DIAGNOSIS"))
SET OROK=1
End DoDot:1
if OROK
QUIT
+6 IF 'OROK
Begin DoDot:1
+7 SET I=0
FOR
SET I=$ORDER(X("PROCEDURE",I))
if 'I
QUIT
Begin DoDot:2
+8 IF $GET(X("PROCEDURE",I,"PROCEDURE"))
SET OROK=1
End DoDot:2
if OROK
QUIT
End DoDot:1
+9 IF $DATA(X("PROVIDER",1,"NAME"))
SET OROK=1
+10 QUIT OROK
NONCOUNT(ORY,ORLOC) ; Is the location a non-count clinic? (DBIA #964)
+1 if 'ORLOC
QUIT
+2 SET ORY=$SELECT($PIECE($GET(^SC(ORLOC,0)),U,17)="Y":1,1:0)
+3 QUIT
+4 ;
