ORWPCE1 ;SLC/KCM - PCE Calls from CPRS GUI; 10/26/04 ;4/9/08 07:44
;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,116,132,148,187,190,215,243**;Dec 17, 1997;Build 242
;
; DBIA 1365 DSELECT^GMPLENFM ^TMP("IB",$J)
;
GETVSIT(VSTR,DFN) ; lookup a visit
N PKG,SRC,ORPXAPI,OK,ORVISIT
S PKG=$O(^DIC(9.4,"B","ORDER ENTRY/RESULTS REPORTING",0))
S SRC="TEXT INTEGRATION UTILITIES"
S ORPXAPI("ENCOUNTER",1,"ENC D/T")=$P(VSTR,";",2)
S ORPXAPI("ENCOUNTER",1,"PATIENT")=DFN
S ORPXAPI("ENCOUNTER",1,"HOS LOC")=+VSTR
S ORPXAPI("ENCOUNTER",1,"SERVICE CATEGORY")=$P(VSTR,";",3)
S ORPXAPI("ENCOUNTER",1,"ENCOUNTER TYPE")="P"
S OK=$$DATA2PCE^PXAPI("ORPXAPI",PKG,SRC,.ORVISIT)
Q ORVISIT
DQDEL ; background call to DATA2PCE and DELVFILE
N VISIT,VAL
I $D(ZTQUEUED) S ZTREQ="@"
S VISIT=$$GETVSIT(VSTR,DFN)
S VAL=$$DELVFILE^PXAPI("ALL",VISIT,"","TEXT INTEGRATION UTILITIES")
S ZTSTAT=0 ; clear sync flag
Q
DQSAVE ; Background Call to DATA2PCE
N PKG,SRC,TYP,CODE,IEN,OK,I,X,ORPXAPI,ORPXDEL
N CAT,NARR,ROOT,ROOT2,ORAVST
N PRV,CPT,ICD,IMM,SK,PED,HF,XAM,TRT,MOD,MODCNT,MODIDX,MODS
N COM,COMMENT,COMMENTS
N DFN,PROBLEMS,PXAPREDT,ORCPTDEL
I $D(ZTQUEUED) S ZTREQ="@"
S PKG=$O(^DIC(9.4,"B","ORDER ENTRY/RESULTS REPORTING",0))
S SRC="TEXT INTEGRATION UTILITIES"
S (PRV,CPT,ICD,IMM,SK,PED,HF,XAM,TRT)=0
S I="" F S I=$O(PCELIST(I)) Q:'I S X=PCELIST(I) D
. S X=PCELIST(I),TYP=$P(X,U),CODE=$P(X,U,2),CAT=$P(X,U,3),NARR=$P(X,U,4)
. I $E(TYP,1,3)="PRV" D Q
. . Q:'$L(CODE)
. . S PRV=PRV+1
. . S ROOT="ORPXAPI(""PROVIDER"","_PRV_")"
. . S ROOT2="ORPXDEL(""PROVIDER"","_PRV_")"
. . I $E(TYP,4)'="-" D
. . . S @ROOT@("NAME")=CODE
. . . S @ROOT@("PRIMARY")=$P(X,U,6)
. . S @ROOT2@("NAME")=CODE
. . S @ROOT2@("DELETE")=1
. . S PXAPREDT=1 ;Allow edit of primary flag
. I TYP="VST" D Q
. . S ROOT="ORPXAPI(""ENCOUNTER"",1)"
. . I CODE="DT" S @ROOT@("ENC D/T")=$P(X,U,3) Q
. . I CODE="PT" S @ROOT@("PATIENT")=$P(X,U,3),DFN=$P(X,U,3) Q
. . I CODE="HL" S @ROOT@("HOS LOC")=$P(X,U,3) Q
. . I CODE="PR" S @ROOT@("PARENT")=$P(X,U,3) Q
. . ;prevents checkout!
. . I CODE="VC" S @ROOT@("SERVICE CATEGORY")=$P(X,U,3) Q
. . I CODE="SC" S @ROOT@("SC")=$P(X,U,3) Q
. . I CODE="AO" S @ROOT@("AO")=$P(X,U,3) Q
. . I CODE="IR" S @ROOT@("IR")=$P(X,U,3) Q
. . I CODE="EC" S @ROOT@("EC")=$P(X,U,3) Q
. . I CODE="MST" S @ROOT@("MST")=$P(X,U,3) Q
. . I CODE="HNC" S @ROOT@("HNC")=$P(X,U,3) Q
. . I CODE="CV" S @ROOT@("CV")=$P(X,U,3) Q
. . I CODE="SHD" S @ROOT@("SHAD")=$P(X,U,3) Q
. . I CODE="OL" D Q
. . . I +$P(X,U,3) S @ROOT@("INSTITUTION")=$P(X,U,3)
. . . E I $P(X,U,4)'="",$P(X,U,4)'="0" D
. . . . I $$PATCH^XPDUTL("PX*1.0*96") S @ROOT@("OUTSIDE LOCATION")=$P(X,U,4)
. . . . E S @ROOT@("COMMENT")="OUTSIDE LOCATION: "_$P(X,U,4)
. I $E(TYP,1,3)="CPT" D Q
. . Q:'$L(CODE)
. . S CPT=CPT+1,ROOT="ORPXAPI(""PROCEDURE"","_CPT_")"
. . S IEN=+$O(^ICPT("B",CODE,0))
. . S @ROOT@("PROCEDURE")=IEN
. . I +$P(X,U,9) D
. . . S MODS=$P(X,U,9),MODCNT=+MODS
. . . F MODIDX=1:1:MODCNT D
. . . . S MOD=$P($P(MODS,";",MODIDX+1),"/")
. . . . S @ROOT@("MODIFIERS",MOD)=""
. . S:$L(CAT) @ROOT@("CATEGORY")=CAT
. . S:$L(NARR) @ROOT@("NARRATIVE")=NARR
. . S:$L($P(X,U,5)) @ROOT@("QTY")=$P(X,U,5)
. . S:$P(X,U,6)>0 @ROOT@("ENC PROVIDER")=$P(X,U,6)
. . S:$L($P(X,U,10))>0 COMMENT($P(X,U,10))="PROCEDURE^"_CPT
. . I $E(TYP,4)="-" S @ROOT@("DELETE")=1,@ROOT@("QTY")=0,ORCPTDEL=CPT
. I $E(TYP,1,3)="POV" D Q
. . Q:'$L(CODE)
. . S ICD=ICD+1,ROOT="ORPXAPI(""DX/PL"","_ICD_")"
. . S IEN=+$O(^ICD9("AB",CODE_" ",0))
. . S @ROOT@("DIAGNOSIS")=IEN
. . S @ROOT@("PRIMARY")=$P(X,U,5)
. . S:$L(CAT) @ROOT@("CATEGORY")=CAT
. . S:$L(NARR) @ROOT@("NARRATIVE")=NARR
. . S:$P(X,U,6)>0 @ROOT@("ENC PROVIDER")=$P(X,U,6)
. . I $L($P(X,U,7)),$P(X,U,7)=1 S @ROOT@("PL ADD")=$P(X,U,7),PROBLEMS(ICD)=NARR_U_CODE
. . S:$L($P(X,U,10))>0 COMMENT($P(X,U,10))="DX/PL^"_ICD
. . I $E(TYP,4)="-" S @ROOT@("DELETE")=1
. I $E(TYP,1,3)="IMM" D Q
. . Q:'$L(CODE)
. . S IMM=IMM+1,ROOT="ORPXAPI(""IMMUNIZATION"","_IMM_")"
. . S @ROOT@("IMMUN")=CODE
. . S:$L($P(X,U,5)) @ROOT@("SERIES")=$P(X,U,5)
. . S:$L($P(X,U,5)) @ROOT@("REACTION")=$P(X,U,7)
. . S:$L($P(X,U,8)) @ROOT@("CONTRAINDICATED")=$P(X,U,8)
. . S:$L($P(X,U,9)) @ROOT@("REFUSED")=$P(X,U,9)
. . S:$P(X,U,6)>0 @ROOT@("ENC PROVIDER")=$P(X,U,6)
. . S:$L($P(X,U,10))>0 COMMENT($P(X,U,10))="IMMUNIZATION^"_IMM
. . I $E(TYP,4)="-" S @ROOT@("DELETE")=1
. I $E(TYP,1,2)="SK" D Q
. . Q:'$L(CODE)
. . S SK=SK+1,ROOT="ORPXAPI(""SKIN TEST"","_SK_")"
. . S @ROOT@("TEST")=CODE
. . S:$L($P(X,U,5)) @ROOT@("RESULT")=$P(X,U,5)
. . S:$L($P(X,U,7)) @ROOT@("READING")=$P(X,U,7)
. . S:$L($P(X,U,8)) @ROOT@("D/T READ")=$P(X,U,8)
. . S:$L($P(X,U,9)) @ROOT@("EVENT D/T")=$P(X,U,9)
. . S:$P(X,U,6)>0 @ROOT@("ENC PROVIDER")=$P(X,U,6)
. . S:$L($P(X,U,10))>0 COMMENT($P(X,U,10))="SKIN TEST^"_SK
. . I $E(TYP,3)="-" S @ROOT@("DELETE")=1
. I $E(TYP,1,3)="PED" D Q
. . Q:'$L(CODE)
. . S PED=PED+1,ROOT="ORPXAPI(""PATIENT ED"","_PED_")"
. . S @ROOT@("TOPIC")=CODE
. . S:$L($P(X,U,5)) @ROOT@("UNDERSTANDING")=$P(X,U,5)
. . S:$P(X,U,6)>0 @ROOT@("ENC PROVIDER")=$P(X,U,6)
. . S:$L($P(X,U,10))>0 COMMENT($P(X,U,10))="PATIENT ED^"_PED
. . I $E(TYP,4)="-" S @ROOT@("DELETE")=1
. I $E(TYP,1,2)="HF" D Q
. . Q:'$L(CODE)
. . S HF=HF+1,ROOT="ORPXAPI(""HEALTH FACTOR"","_HF_")"
. . S @ROOT@("HEALTH FACTOR")=CODE
. . S:$L($P(X,U,5)) @ROOT@("LEVEL/SEVERITY")=$P(X,U,5)
. . S:$P(X,U,6)'>0 $P(X,U,6)=$G(ORPXAPI("PROVIDER",1,"NAME"))
. . S:$P(X,U,6)>0 @ROOT@("ENC PROVIDER")=$P(X,U,6)
. . S:$L($P(X,U,11)) @ROOT@("EVENT D/T")=$P($P(X,U,11),";",1)
. . S:$L($P(X,U,11)) SRC=$P($P(X,U,11),";",2)
. . S:$L($P(X,U,10))>0 COMMENT($P(X,U,10))="HEALTH FACTOR^"_HF
. . I $E(TYP,3)="-" S @ROOT@("DELETE")=1
. I $E(TYP,1,3)="XAM" D Q
. . Q:'$L(CODE)
. . S XAM=XAM+1,ROOT="ORPXAPI(""EXAM"","_XAM_")"
. . S @ROOT@("EXAM")=CODE
. . S:$L($P(X,U,5)) @ROOT@("RESULT")=$P(X,U,5)
. . S:$P(X,U,6)>0 @ROOT@("ENC PROVIDER")=$P(X,U,6)
. . S:$L($P(X,U,10))>0 COMMENT($P(X,U,10))="EXAM^"_XAM
. . I $E(TYP,4)="-" S @ROOT@("DELETE")=1
. I $E(TYP,1,3)="TRT" D Q
. . Q:'$L(CODE)
. . S TRT=TRT+1,ROOT="ORPXAPI(""TREATMENT"","_TRT_")"
. . S @ROOT@("IMMUN")=CODE
. . S:$L(CAT) @ROOT@("CATEGORY")=CAT
. . S:$L(NARR) @ROOT@("NARRATIVE")=NARR
. . S:$L($P(X,U,5)) @ROOT@("QTY")=$P(X,U,5)
. . S:$P(X,U,6)>0 @ROOT@("ENC PROVIDER")=$P(X,U,6)
. . S:$L($P(X,U,10))>0 COMMENT($P(X,U,10))="TREATMENT^"_TRT
. . I $E(TYP,4)="-" S @ROOT@("DELETE")=1,@ROOT@("QTY")=0
. I $E(TYP,1,3)="COM" D Q
. . Q:'$L(CODE)
. . Q:'$L(CAT)
. . S COMMENTS(CODE)=$P(X,U,3,999)
;Store the comments
S COM=""
F S COM=$O(COMMENT(COM)) Q:COM="" S:$D(COMMENTS(COM)) ORPXAPI($P(COMMENT(COM),"^",1),$P(COMMENT(COM),"^",2),"COMMENT")=COMMENTS(COM)
;
;Remove any problems to add that the patient already has as active problems
I $D(PROBLEMS),$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(PROBLEMS(ORPROBIX)) Q:'ORPROBIX D
.. S:$D(ORWPROB(PROBLEMS(ORPROBIX))) ORPXAPI("DX/PL",ORPROBIX,"PL ADD")=0
;
I $$MDS(.ORPXAPI,$G(ORLOC)) S ORPXAPI("ENCOUNTER",1,"CHECKOUT D/T")=$$NOW^XLFDT
S ORPXAPI("ENCOUNTER",1,"ENCOUNTER TYPE")="P"
DATA2PCE ;
I $G(PXAPREDT)!($G(ORCPTDEL)) D
. M ORPXDEL("ENCOUNTER")=ORPXAPI("ENCOUNTER")
. I $G(ORCPTDEL) M ORPXDEL("PROCEDURE",ORCPTDEL)=ORPXAPI("PROCEDURE",ORCPTDEL)
. S OK=$$DATA2PCE^PXAPI("ORPXDEL",PKG,SRC,.ORAVST)
S OK=$$DATA2PCE^PXAPI("ORPXAPI",PKG,SRC,.ORAVST)
I OK>0,+NOTEIEN,+ORAVST D ; NOTEIEN only set on inpatient encounters
.N OROK,ORX
.S ORX(1207)=ORAVST
.D FILE^TIUSRVP(.OROK,NOTEIEN,.ORX,1)
S ZTSTAT=0 ; clear sync flag
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
ORWPCE1 ;SLC/KCM - PCE Calls from CPRS GUI; 10/26/04 ;4/9/08 07:44
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,116,132,148,187,190,215,243**;Dec 17, 1997;Build 242
+2 ;
+3 ; DBIA 1365 DSELECT^GMPLENFM ^TMP("IB",$J)
+4 ;
GETVSIT(VSTR,DFN) ; lookup a visit
+1 NEW PKG,SRC,ORPXAPI,OK,ORVISIT
+2 SET PKG=$ORDER(^DIC(9.4,"B","ORDER ENTRY/RESULTS REPORTING",0))
+3 SET SRC="TEXT INTEGRATION UTILITIES"
+4 SET ORPXAPI("ENCOUNTER",1,"ENC D/T")=$PIECE(VSTR,";",2)
+5 SET ORPXAPI("ENCOUNTER",1,"PATIENT")=DFN
+6 SET ORPXAPI("ENCOUNTER",1,"HOS LOC")=+VSTR
+7 SET ORPXAPI("ENCOUNTER",1,"SERVICE CATEGORY")=$PIECE(VSTR,";",3)
+8 SET ORPXAPI("ENCOUNTER",1,"ENCOUNTER TYPE")="P"
+9 SET OK=$$DATA2PCE^PXAPI("ORPXAPI",PKG,SRC,.ORVISIT)
+10 QUIT ORVISIT
DQDEL ; background call to DATA2PCE and DELVFILE
+1 NEW VISIT,VAL
+2 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+3 SET VISIT=$$GETVSIT(VSTR,DFN)
+4 SET VAL=$$DELVFILE^PXAPI("ALL",VISIT,"","TEXT INTEGRATION UTILITIES")
+5 ; clear sync flag
SET ZTSTAT=0
+6 QUIT
DQSAVE ; Background Call to DATA2PCE
+1 NEW PKG,SRC,TYP,CODE,IEN,OK,I,X,ORPXAPI,ORPXDEL
+2 NEW CAT,NARR,ROOT,ROOT2,ORAVST
+3 NEW PRV,CPT,ICD,IMM,SK,PED,HF,XAM,TRT,MOD,MODCNT,MODIDX,MODS
+4 NEW COM,COMMENT,COMMENTS
+5 NEW DFN,PROBLEMS,PXAPREDT,ORCPTDEL
+6 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+7 SET PKG=$ORDER(^DIC(9.4,"B","ORDER ENTRY/RESULTS REPORTING",0))
+8 SET SRC="TEXT INTEGRATION UTILITIES"
+9 SET (PRV,CPT,ICD,IMM,SK,PED,HF,XAM,TRT)=0
+10 SET I=""
FOR
SET I=$ORDER(PCELIST(I))
IF 'I
QUIT
SET X=PCELIST(I)
Begin DoDot:1
+11 SET X=PCELIST(I)
SET TYP=$PIECE(X,U)
SET CODE=$PIECE(X,U,2)
SET CAT=$PIECE(X,U,3)
SET NARR=$PIECE(X,U,4)
+12 IF $EXTRACT(TYP,1,3)="PRV"
Begin DoDot:2
+13 IF '$LENGTH(CODE)
QUIT
+14 SET PRV=PRV+1
+15 SET ROOT="ORPXAPI(""PROVIDER"","_PRV_")"
+16 SET ROOT2="ORPXDEL(""PROVIDER"","_PRV_")"
+17 IF $EXTRACT(TYP,4)'="-"
Begin DoDot:3
+18 SET @ROOT@("NAME")=CODE
+19 SET @ROOT@("PRIMARY")=$PIECE(X,U,6)
End DoDot:3
+20 SET @ROOT2@("NAME")=CODE
+21 SET @ROOT2@("DELETE")=1
+22 ;Allow edit of primary flag
SET PXAPREDT=1
End DoDot:2
QUIT
+23 IF TYP="VST"
Begin DoDot:2
+24 SET ROOT="ORPXAPI(""ENCOUNTER"",1)"
+25 IF CODE="DT"
SET @ROOT@("ENC D/T")=$PIECE(X,U,3)
QUIT
+26 IF CODE="PT"
SET @ROOT@("PATIENT")=$PIECE(X,U,3)
SET DFN=$PIECE(X,U,3)
QUIT
+27 IF CODE="HL"
SET @ROOT@("HOS LOC")=$PIECE(X,U,3)
QUIT
+28 IF CODE="PR"
SET @ROOT@("PARENT")=$PIECE(X,U,3)
QUIT
+29 ;prevents checkout!
+30 IF CODE="VC"
SET @ROOT@("SERVICE CATEGORY")=$PIECE(X,U,3)
QUIT
+31 IF CODE="SC"
SET @ROOT@("SC")=$PIECE(X,U,3)
QUIT
+32 IF CODE="AO"
SET @ROOT@("AO")=$PIECE(X,U,3)
QUIT
+33 IF CODE="IR"
SET @ROOT@("IR")=$PIECE(X,U,3)
QUIT
+34 IF CODE="EC"
SET @ROOT@("EC")=$PIECE(X,U,3)
QUIT
+35 IF CODE="MST"
SET @ROOT@("MST")=$PIECE(X,U,3)
QUIT
+36 IF CODE="HNC"
SET @ROOT@("HNC")=$PIECE(X,U,3)
QUIT
+37 IF CODE="CV"
SET @ROOT@("CV")=$PIECE(X,U,3)
QUIT
+38 IF CODE="SHD"
SET @ROOT@("SHAD")=$PIECE(X,U,3)
QUIT
+39 IF CODE="OL"
Begin DoDot:3
+40 IF +$PIECE(X,U,3)
SET @ROOT@("INSTITUTION")=$PIECE(X,U,3)
+41 IF '$TEST
IF $PIECE(X,U,4)'=""
IF $PIECE(X,U,4)'="0"
Begin DoDot:4
+42 IF $$PATCH^XPDUTL("PX*1.0*96")
SET @ROOT@("OUTSIDE LOCATION")=$PIECE(X,U,4)
+43 IF '$TEST
SET @ROOT@("COMMENT")="OUTSIDE LOCATION: "_$PIECE(X,U,4)
End DoDot:4
End DoDot:3
QUIT
End DoDot:2
QUIT
+44 IF $EXTRACT(TYP,1,3)="CPT"
Begin DoDot:2
+45 IF '$LENGTH(CODE)
QUIT
+46 SET CPT=CPT+1
SET ROOT="ORPXAPI(""PROCEDURE"","_CPT_")"
+47 SET IEN=+$ORDER(^ICPT("B",CODE,0))
+48 SET @ROOT@("PROCEDURE")=IEN
+49 IF +$PIECE(X,U,9)
Begin DoDot:3
+50 SET MODS=$PIECE(X,U,9)
SET MODCNT=+MODS
+51 FOR MODIDX=1:1:MODCNT
Begin DoDot:4
+52 SET MOD=$PIECE($PIECE(MODS,";",MODIDX+1),"/")
+53 SET @ROOT@("MODIFIERS",MOD)=""
End DoDot:4
End DoDot:3
+54 IF $LENGTH(CAT)
SET @ROOT@("CATEGORY")=CAT
+55 IF $LENGTH(NARR)
SET @ROOT@("NARRATIVE")=NARR
+56 IF $LENGTH($PIECE(X,U,5))
SET @ROOT@("QTY")=$PIECE(X,U,5)
+57 IF $PIECE(X,U,6)>0
SET @ROOT@("ENC PROVIDER")=$PIECE(X,U,6)
+58 IF $LENGTH($PIECE(X,U,10))>0
SET COMMENT($PIECE(X,U,10))="PROCEDURE^"_CPT
+59 IF $EXTRACT(TYP,4)="-"
SET @ROOT@("DELETE")=1
SET @ROOT@("QTY")=0
SET ORCPTDEL=CPT
End DoDot:2
QUIT
+60 IF $EXTRACT(TYP,1,3)="POV"
Begin DoDot:2
+61 IF '$LENGTH(CODE)
QUIT
+62 SET ICD=ICD+1
SET ROOT="ORPXAPI(""DX/PL"","_ICD_")"
+63 SET IEN=+$ORDER(^ICD9("AB",CODE_" ",0))
+64 SET @ROOT@("DIAGNOSIS")=IEN
+65 SET @ROOT@("PRIMARY")=$PIECE(X,U,5)
+66 IF $LENGTH(CAT)
SET @ROOT@("CATEGORY")=CAT
+67 IF $LENGTH(NARR)
SET @ROOT@("NARRATIVE")=NARR
+68 IF $PIECE(X,U,6)>0
SET @ROOT@("ENC PROVIDER")=$PIECE(X,U,6)
+69 IF $LENGTH($PIECE(X,U,7))
IF $PIECE(X,U,7)=1
SET @ROOT@("PL ADD")=$PIECE(X,U,7)
SET PROBLEMS(ICD)=NARR_U_CODE
+70 IF $LENGTH($PIECE(X,U,10))>0
SET COMMENT($PIECE(X,U,10))="DX/PL^"_ICD
+71 IF $EXTRACT(TYP,4)="-"
SET @ROOT@("DELETE")=1
End DoDot:2
QUIT
+72 IF $EXTRACT(TYP,1,3)="IMM"
Begin DoDot:2
+73 IF '$LENGTH(CODE)
QUIT
+74 SET IMM=IMM+1
SET ROOT="ORPXAPI(""IMMUNIZATION"","_IMM_")"
+75 SET @ROOT@("IMMUN")=CODE
+76 IF $LENGTH($PIECE(X,U,5))
SET @ROOT@("SERIES")=$PIECE(X,U,5)
+77 IF $LENGTH($PIECE(X,U,5))
SET @ROOT@("REACTION")=$PIECE(X,U,7)
+78 IF $LENGTH($PIECE(X,U,8))
SET @ROOT@("CONTRAINDICATED")=$PIECE(X,U,8)
+79 IF $LENGTH($PIECE(X,U,9))
SET @ROOT@("REFUSED")=$PIECE(X,U,9)
+80 IF $PIECE(X,U,6)>0
SET @ROOT@("ENC PROVIDER")=$PIECE(X,U,6)
+81 IF $LENGTH($PIECE(X,U,10))>0
SET COMMENT($PIECE(X,U,10))="IMMUNIZATION^"_IMM
+82 IF $EXTRACT(TYP,4)="-"
SET @ROOT@("DELETE")=1
End DoDot:2
QUIT
+83 IF $EXTRACT(TYP,1,2)="SK"
Begin DoDot:2
+84 IF '$LENGTH(CODE)
QUIT
+85 SET SK=SK+1
SET ROOT="ORPXAPI(""SKIN TEST"","_SK_")"
+86 SET @ROOT@("TEST")=CODE
+87 IF $LENGTH($PIECE(X,U,5))
SET @ROOT@("RESULT")=$PIECE(X,U,5)
+88 IF $LENGTH($PIECE(X,U,7))
SET @ROOT@("READING")=$PIECE(X,U,7)
+89 IF $LENGTH($PIECE(X,U,8))
SET @ROOT@("D/T READ")=$PIECE(X,U,8)
+90 IF $LENGTH($PIECE(X,U,9))
SET @ROOT@("EVENT D/T")=$PIECE(X,U,9)
+91 IF $PIECE(X,U,6)>0
SET @ROOT@("ENC PROVIDER")=$PIECE(X,U,6)
+92 IF $LENGTH($PIECE(X,U,10))>0
SET COMMENT($PIECE(X,U,10))="SKIN TEST^"_SK
+93 IF $EXTRACT(TYP,3)="-"
SET @ROOT@("DELETE")=1
End DoDot:2
QUIT
+94 IF $EXTRACT(TYP,1,3)="PED"
Begin DoDot:2
+95 IF '$LENGTH(CODE)
QUIT
+96 SET PED=PED+1
SET ROOT="ORPXAPI(""PATIENT ED"","_PED_")"
+97 SET @ROOT@("TOPIC")=CODE
+98 IF $LENGTH($PIECE(X,U,5))
SET @ROOT@("UNDERSTANDING")=$PIECE(X,U,5)
+99 IF $PIECE(X,U,6)>0
SET @ROOT@("ENC PROVIDER")=$PIECE(X,U,6)
+100 IF $LENGTH($PIECE(X,U,10))>0
SET COMMENT($PIECE(X,U,10))="PATIENT ED^"_PED
+101 IF $EXTRACT(TYP,4)="-"
SET @ROOT@("DELETE")=1
End DoDot:2
QUIT
+102 IF $EXTRACT(TYP,1,2)="HF"
Begin DoDot:2
+103 IF '$LENGTH(CODE)
QUIT
+104 SET HF=HF+1
SET ROOT="ORPXAPI(""HEALTH FACTOR"","_HF_")"
+105 SET @ROOT@("HEALTH FACTOR")=CODE
+106 IF $LENGTH($PIECE(X,U,5))
SET @ROOT@("LEVEL/SEVERITY")=$PIECE(X,U,5)
+107 IF $PIECE(X,U,6)'>0
SET $PIECE(X,U,6)=$GET(ORPXAPI("PROVIDER",1,"NAME"))
+108 IF $PIECE(X,U,6)>0
SET @ROOT@("ENC PROVIDER")=$PIECE(X,U,6)
+109 IF $LENGTH($PIECE(X,U,11))
SET @ROOT@("EVENT D/T")=$PIECE($PIECE(X,U,11),";",1)
+110 IF $LENGTH($PIECE(X,U,11))
SET SRC=$PIECE($PIECE(X,U,11),";",2)
+111 IF $LENGTH($PIECE(X,U,10))>0
SET COMMENT($PIECE(X,U,10))="HEALTH FACTOR^"_HF
+112 IF $EXTRACT(TYP,3)="-"
SET @ROOT@("DELETE")=1
End DoDot:2
QUIT
+113 IF $EXTRACT(TYP,1,3)="XAM"
Begin DoDot:2
+114 IF '$LENGTH(CODE)
QUIT
+115 SET XAM=XAM+1
SET ROOT="ORPXAPI(""EXAM"","_XAM_")"
+116 SET @ROOT@("EXAM")=CODE
+117 IF $LENGTH($PIECE(X,U,5))
SET @ROOT@("RESULT")=$PIECE(X,U,5)
+118 IF $PIECE(X,U,6)>0
SET @ROOT@("ENC PROVIDER")=$PIECE(X,U,6)
+119 IF $LENGTH($PIECE(X,U,10))>0
SET COMMENT($PIECE(X,U,10))="EXAM^"_XAM
+120 IF $EXTRACT(TYP,4)="-"
SET @ROOT@("DELETE")=1
End DoDot:2
QUIT
+121 IF $EXTRACT(TYP,1,3)="TRT"
Begin DoDot:2
+122 IF '$LENGTH(CODE)
QUIT
+123 SET TRT=TRT+1
SET ROOT="ORPXAPI(""TREATMENT"","_TRT_")"
+124 SET @ROOT@("IMMUN")=CODE
+125 IF $LENGTH(CAT)
SET @ROOT@("CATEGORY")=CAT
+126 IF $LENGTH(NARR)
SET @ROOT@("NARRATIVE")=NARR
+127 IF $LENGTH($PIECE(X,U,5))
SET @ROOT@("QTY")=$PIECE(X,U,5)
+128 IF $PIECE(X,U,6)>0
SET @ROOT@("ENC PROVIDER")=$PIECE(X,U,6)
+129 IF $LENGTH($PIECE(X,U,10))>0
SET COMMENT($PIECE(X,U,10))="TREATMENT^"_TRT
+130 IF $EXTRACT(TYP,4)="-"
SET @ROOT@("DELETE")=1
SET @ROOT@("QTY")=0
End DoDot:2
QUIT
+131 IF $EXTRACT(TYP,1,3)="COM"
Begin DoDot:2
+132 IF '$LENGTH(CODE)
QUIT
+133 IF '$LENGTH(CAT)
QUIT
+134 SET COMMENTS(CODE)=$PIECE(X,U,3,999)
End DoDot:2
QUIT
End DoDot:1
+135 ;Store the comments
+136 SET COM=""
+137 FOR
SET COM=$ORDER(COMMENT(COM))
IF COM=""
QUIT
IF $DATA(COMMENTS(COM))
SET ORPXAPI($PIECE(COMMENT(COM),"^",1),$PIECE(COMMENT(COM),"^",2),"COMMENT")=COMMENTS(COM)
+138 ;
+139 ;Remove any problems to add that the patient already has as active problems
+140 IF $DATA(PROBLEMS)
IF $DATA(DFN)
Begin DoDot:1
+141 NEW ORWPROB,ORPROBIX
+142 KILL ^TMP("IB",$JOB,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS")
+143 ;DBIA 1365
DO DSELECT^GMPLENFM
+144 SET ORPROBIX=0
+145 ;DBIA 1365
FOR
SET ORPROBIX=$ORDER(^TMP("IB",$JOB,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",ORPROBIX))
IF 'ORPROBIX
QUIT
Begin DoDot:2
+146 SET ORWPROB=$PIECE(^TMP("IB",$JOB,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS",ORPROBIX),"^",2,3)
+147 SET ORWPROB($SELECT($EXTRACT(ORWPROB,1)="$":$EXTRACT(ORWPROB,2,255),1:ORWPROB))=""
End DoDot:2
+148 KILL ^TMP("IB",$JOB,"INTERFACES","GMP SELECT PATIENT ACTIVE PROBLEMS")
+149 IF '$DATA(ORWPROB)
QUIT
+150 SET ORPROBIX=""
+151 FOR
SET ORPROBIX=$ORDER(PROBLEMS(ORPROBIX))
IF 'ORPROBIX
QUIT
Begin DoDot:2
+152 IF $DATA(ORWPROB(PROBLEMS(ORPROBIX)))
SET ORPXAPI("DX/PL",ORPROBIX,"PL ADD")=0
End DoDot:2
End DoDot:1
+153 ;
+154 IF $$MDS(.ORPXAPI,$GET(ORLOC))
SET ORPXAPI("ENCOUNTER",1,"CHECKOUT D/T")=$$NOW^XLFDT
+155 SET ORPXAPI("ENCOUNTER",1,"ENCOUNTER TYPE")="P"
DATA2PCE ;
+1 IF $GET(PXAPREDT)!($GET(ORCPTDEL))
Begin DoDot:1
+2 MERGE ORPXDEL("ENCOUNTER")=ORPXAPI("ENCOUNTER")
+3 IF $GET(ORCPTDEL)
MERGE ORPXDEL("PROCEDURE",ORCPTDEL)=ORPXAPI("PROCEDURE",ORCPTDEL)
+4 SET OK=$$DATA2PCE^PXAPI("ORPXDEL",PKG,SRC,.ORAVST)
End DoDot:1
+5 SET OK=$$DATA2PCE^PXAPI("ORPXAPI",PKG,SRC,.ORAVST)
+6 ; NOTEIEN only set on inpatient encounters
IF OK>0
IF +NOTEIEN
IF +ORAVST
Begin DoDot:1
+7 NEW OROK,ORX
+8 SET ORX(1207)=ORAVST
+9 DO FILE^TIUSRVP(.OROK,NOTEIEN,.ORX,1)
End DoDot:1
+10 ; clear sync flag
SET ZTSTAT=0
+11 QUIT
+12 ;
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
