- 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