Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ORWPCE1

ORWPCE1.m

Go to the documentation of this file.
ORWPCE1 ;ISL/KCM,JER - PCE Calls from CPRS GUI ;06/16/2021
 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,85,116,132,148,187,190,215,243,280,306,361,501,559**;Dec 17, 1997;Build 9
 ;
 ; DBIA 1365   DSELECT^GMPLENFM   ^TMP("IB",$J)
 ; References to ICDEX supported by ICR #5747
 ;
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,ORENCDT
 N PRV,CPT,ICD,IMM,SK,PED,HF,XAM,TRT,MOD,MODCNT,MODIDX,MODS
 N COM,COMMENT,COMMENTS,SVCAT
 N DFN,ERRA,ERRPROB,PROBLEMS,PXAPREDT,ORCPTDEL
 N VISITOK
 I $D(ZTQUEUED) S ZTREQ="@"
 S PKG=$O(^DIC(9.4,"B","ORDER ENTRY/RESULTS REPORTING",0))
 S SRC="TEXT INTEGRATION UTILITIES"
 S PXAPREDT=0
 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 PXAPREDT=1 ;Allow edit of primary provider flag
 . . I $E(TYP,4)'="-" D  Q
 . . . S ORPXAPI("PROVIDER",PRV,"NAME")=CODE
 . . . S ORPXAPI("PROVIDER",PRV,"PRIMARY")=$P(X,U,6)
 . . S ORPXDEL("PROVIDER",PRV,"NAME")=CODE
 . . S ORPXDEL("PROVIDER",PRV,"DELETE")=1
 . I TYP="VST" D  Q
 . . I CODE="DT" S (ORENCDT,ORPXAPI("ENCOUNTER",1,"ENC D/T"))=$P(X,U,3) Q
 . . I CODE="PT" S ORPXAPI("ENCOUNTER",1,"PATIENT")=$P(X,U,3),DFN=$P(X,U,3) Q
 . . I CODE="HL" S ORPXAPI("ENCOUNTER",1,"HOS LOC")=$P(X,U,3) Q
 . . I CODE="PR" S ORPXAPI("ENCOUNTER",1,"PARENT")=$P(X,U,3) Q
 . . ;prevents checkout!
 . . I CODE="VC" S (SVCAT,ORPXAPI("ENCOUNTER",1,"SERVICE CATEGORY"))=$P(X,U,3) Q
 . . I CODE="SC" S ORPXAPI("ENCOUNTER",1,"SC")=$P(X,U,3) Q
 . . I CODE="AO" S ORPXAPI("ENCOUNTER",1,"AO")=$P(X,U,3) Q
 . . I CODE="IR" S ORPXAPI("ENCOUNTER",1,"IR")=$P(X,U,3) Q
 . . I CODE="EC" S ORPXAPI("ENCOUNTER",1,"EC")=$P(X,U,3) Q
 . . I CODE="MST" S ORPXAPI("ENCOUNTER",1,"MST")=$P(X,U,3) Q
 . . I CODE="HNC" S ORPXAPI("ENCOUNTER",1,"HNC")=$P(X,U,3) Q
 . . I CODE="CV" S ORPXAPI("ENCOUNTER",1,"CV")=$P(X,U,3) Q
 . . I CODE="SHD" S ORPXAPI("ENCOUNTER",1,"SHAD")=$P(X,U,3) Q
 . . I CODE="OL" D  Q
 . . . I +$P(X,U,3) S ORPXAPI("ENCOUNTER",1,"INSTITUTION")=$P(X,U,3)
 . . . E  I $P(X,U,4)'="",$P(X,U,4)'="0" S ORPXAPI("ENCOUNTER",1,"OUTSIDE LOCATION")=$P(X,U,4)
 . I $E(TYP,1,3)="CPT" D  Q
 . . Q:'$L(CODE)
 . . S CPT=CPT+1
 . . S IEN=$$CODEN^ICPTCOD(CODE) ;ICR #1995
 . . S ORPXAPI("PROCEDURE",CPT,"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 ORPXAPI("PROCEDURE",CPT,"MODIFIERS",MOD)=""
 . . S:$L(CAT) ORPXAPI("PROCEDURE",CPT,"CATEGORY")=CAT
 . . S:$L(NARR) ORPXAPI("PROCEDURE",CPT,"NARRATIVE")=NARR
 . . S:$L($P(X,U,5)) ORPXAPI("PROCEDURE",CPT,"QTY")=$P(X,U,5)
 . . S:$P(X,U,6)>0 ORPXAPI("PROCEDURE",CPT,"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 ORPXAPI("PROCEDURE",CPT,"DELETE")=1,ORPXAPI("PROCEDURE",CPT,"QTY")=0,ORCPTDEL=CPT
 . I $E(TYP,1,3)="POV" D  Q
 . . N ORDXI,ORDX
 . . Q:'$L(CODE)
 . . F ORDXI=1:1:$L(CODE,"/") D
 . . . N CDT,CSYS,IEN,LEXIEN
 . . . S ORDX=$P(CODE,"/",ORDXI)
 . . . S ICD=ICD+1
 . . . I (ORDX]""),(ORDX'[".") S ORDX=ORDX_"."
 . . . S IEN=$P($$CODEN^ICDEX(ORDX,80),"~",1)
 . . . I IEN'>0 Q
 . . . S ORPXAPI("DX/PL",ICD,"DIAGNOSIS")=IEN
 . . . S ORPXAPI("DX/PL",ICD,"PRIMARY")=$S(ORDXI=1:$P(X,U,5),1:0)
 . . . S CDT=$S($G(SVCAT)="E":DT,1:ORENCDT)
 . . . S CSYS=$$CSI^ICDEX(80,IEN)
 . . . S LEXIEN=$P($$EXP^LEXCODE(ORDX,CSYS,CDT),U),ORPXAPI("DX/PL",ICD,"LEXICON TERM")=$S(LEXIEN>0:LEXIEN,1:"")
 . . . S:$L(CAT) ORPXAPI("DX/PL",ICD,"CATEGORY")=CAT
 . . . S:$L(NARR) ORPXAPI("DX/PL",ICD,"NARRATIVE")=NARR
 . . . S:$P(X,U,6)>0 ORPXAPI("DX/PL",ICD,"ENC PROVIDER")=$P(X,U,6)
 . . . I $L($P(X,U,7)),($P(X,U,7)=1),(ORDXI=1) S ORPXAPI("DX/PL",ICD,"PL ADD")=$P(X,U,7),PROBLEMS(ICD)=NARR_U_CODE
 . . . S:$L($P(X,U,10))>0&(ORDXI=1) COMMENT($P(X,U,10))="DX/PL^"_ICD
 . . . I $E(TYP,4)="-" S ORPXAPI("DX/PL",ICD,"DELETE")=1
 . I $E(TYP,1,3)="IMM" D  Q
 . . Q:'$L(CODE)
 . . S IMM=IMM+1
 . . S ORPXAPI("IMMUNIZATION",IMM,"IMMUN")=CODE
 . . S:$L($P(X,U,5)) ORPXAPI("IMMUNIZATION",IMM,"SERIES")=$P(X,U,5)
 . . S:$L($P(X,U,7)) ORPXAPI("IMMUNIZATION",IMM,"REACTION")=$P(X,U,7)
 . . S:$L($P(X,U,8)) ORPXAPI("IMMUNIZATION",IMM,"CONTRAINDICATED")=$P(X,U,8)
 . . S:$L($P(X,U,9)) ORPXAPI("IMMUNIZATION",IMM,"REFUSED")=$P(X,U,9)
 . . S:$P(X,U,6)>0 ORPXAPI("IMMUNIZATION",IMM,"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 ORPXAPI("IMMUNIZATION",IMM,"DELETE")=1
 . I $E(TYP,1,2)="SK" D  Q
 . . Q:'$L(CODE)
 . . S SK=SK+1
 . . S ORPXAPI("SKIN TEST",SK,"TEST")=CODE
 . . S:$L($P(X,U,5)) ORPXAPI("SKIN TEST",SK,"RESULT")=$P(X,U,5)
 . . S:$L($P(X,U,7)) ORPXAPI("SKIN TEST",SK,"READING")=$P(X,U,7)
 . . S:$L($P(X,U,8)) ORPXAPI("SKIN TEST",SK,"D/T READ")=$P(X,U,8)
 . . S:$L($P(X,U,9)) ORPXAPI("SKIN TEST",SK,"EVENT D/T")=$P(X,U,9)
 . . S:$P(X,U,6)>0 ORPXAPI("SKIN TEST",SK,"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 ORPXAPI("SKIN TEST",SK,"DELETE")=1
 . I $E(TYP,1,3)="PED" D  Q
 . . Q:'$L(CODE)
 . . S PED=PED+1
 . . S ORPXAPI("PATIENT ED",PED,"TOPIC")=CODE
 . . S:$L($P(X,U,5)) ORPXAPI("PATIENT ED",PED,"UNDERSTANDING")=$P(X,U,5)
 . . S:$P(X,U,6)>0 ORPXAPI("PATIENT ED",PED,"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 ORPXAPI("PATIENT ED",PED,"DELETE")=1
 . I $E(TYP,1,2)="HF" D  Q
 . . Q:'$L(CODE)
 . . S HF=HF+1
 . . S ORPXAPI("HEALTH FACTOR",HF,"HEALTH FACTOR")=CODE
 . . S:$L($P(X,U,5)) ORPXAPI("HEALTH FACTOR",HF,"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 ORPXAPI("HEALTH FACTOR",HF,"ENC PROVIDER")=$P(X,U,6)
 . . S:$L($P(X,U,11)) ORPXAPI("HEALTH FACTOR",HF,"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 ORPXAPI("HEALTH FACTOR",HF,"DELETE")=1
 . I $E(TYP,1,3)="XAM" D  Q
 . . Q:'$L(CODE)
 . . S XAM=XAM+1
 . . S ORPXAPI("EXAM",XAM,"EXAM")=CODE
 . . S:$L($P(X,U,5)) ORPXAPI("EXAM",XAM,"RESULT")=$P(X,U,5)
 . . S:$P(X,U,6)>0 ORPXAPI("EXAM",XAM,"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 ORPXAPI("EXAM",XAM,"DELETE")=1
 . I $E(TYP,1,3)="TRT" D  Q
 . . Q:'$L(CODE)
 . . S TRT=TRT+1,ROOT="ORPXAPI(""TREATMENT"","_TRT_")"
 . . S ORPXAPI("TREATMENT",TRT,"IMMUN")=CODE
 . . S:$L(CAT) ORPXAPI("TREATMENT",TRT,"CATEGORY")=CAT
 . . S:$L(NARR) ORPXAPI("TREATMENT",TRT,"NARRATIVE")=NARR
 . . S:$L($P(X,U,5)) ORPXAPI("TREATMENT",TRT,"QTY")=$P(X,U,5)
 . . S:$P(X,U,6)>0 ORPXAPI("TREATMENT",TRT,"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 ORPXAPI("TREATMENT",TRT,"DELETE")=1,ORPXAPI("TREATMENT",TRT,"QTY")=0
 . I $E(TYP,1,3)="COM" D  Q
 . . Q:'$L(CODE)
 . . Q:'$L(CAT)
 . . S COMMENTS(CODE)=$P(X,U,3)
 ;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)) D
 .N ORTIME
 .S ORTIME=$$NOW^XLFDT
 .S ORTIME=+($P(ORTIME,".")_"."_$E($P(ORTIME,".",2),1,4))
 .S ORPXAPI("ENCOUNTER",1,"CHECKOUT D/T")=ORTIME
 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,DUZ,0,.ERRA,PXAPREDT,.ERRPROB)
 S OK=$$DATA2PCE^PXAPI("ORPXAPI",PKG,SRC,.ORAVST,DUZ,0,.ERRA,PXAPREDT,.ERRPROB)
 S VISITOK=$S(OK=1:1,(OK=-1)&(+ORAVST>0):1,(OK=-5)&(+ORAVST>0):1,1:0)
 ;I OK>0,+NOTEIEN,+ORAVST D  ; NOTEIEN only set on inpatient encounters
 ;NOTEIEN only set on inpatient encounters.
 I VISITOK,+NOTEIEN D
 .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