Routine: ORWPCE1

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

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

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)

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)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORWPCE1   5602     printed  Feb 19, 2025@00:03:31                                                                                                                                                                                                     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       ;

ORWPCE1.m