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

ORWDX1.m

Go to the documentation of this file.
  1. ORWDX1 ; SLC/KCM/REV - Utilities for Order Dialogs ;06/20/17 07:41
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**85,187,195,215,243,296,341,350,461**;Dec 17, 1997;Build 8
  1. ;
  1. ;
  1. ;
  1. ;Reference to ^PSSORUTE supported by ICR #4555
  1. ;Reference to ^SC( supported by ICR #10040
  1. ;Reference to ^DIC(42 supported by ICR #10039
  1. ;Reference to ^DPT( supported by ICR #10035
  1. ;
  1. WRLST(LST,LOC) ; Return list of dialogs for writing orders
  1. ; .Y(n): DlgName^ListBox Text
  1. WRLST1 N ANENT
  1. S LOC=+$G(LOC)_";SC(" I 'LOC S LOC=""
  1. S ANENT="ALL^"_LOC_$S($G(^VA(200,DUZ,5)):"^SRV.`"_+$G(^(5)),1:"")
  1. D WRLSTB(.LST) Q:$D(LST)>1 ; check ORWDX WRITE ORDERS first
  1. N ORX,X0,X5,ORERR,I,SEQ,IEN,DGRP,FID,TXT,TYP
  1. D GETLST^XPAR(.ORX,ANENT,"ORWOR WRITE ORDERS LIST","Q",.ORERR) Q:ORERR
  1. S I=0 F S I=$O(ORX(I)) Q:'I D
  1. . S SEQ=+ORX(I),IEN=$P(ORX(I),U,2),X0=$G(^ORD(101.41,+IEN,0)),X5=$G(^(5))
  1. . S DGRP=+$P(X0,U,5),FID=+$P(X5,U,5),TXT=$P(X5,U,4),TYP=$P(X0,U,4)
  1. . S:'$L(TXT) TXT=$P(X0,U,2)
  1. . I $P(X0,U,4)="M" S:'FID FID=1001
  1. . S LST(SEQ)=IEN_";"_FID_";"_DGRP_";"_TYP_U_TXT
  1. Q
  1. WRLSTB(LST) ; return menu from which Write Orders list is built
  1. N MNU,SEQ,IEN,ITM,TXT,FID,DGRP,X,TYP
  1. S MNU=$$GET^XPAR(ANENT,"ORWDX WRITE ORDERS LIST",1,"I") Q:'MNU
  1. S SEQ=0 F S SEQ=$O(^ORD(101.41,MNU,10,"B",SEQ)) Q:'SEQ D
  1. . S IEN=0 F S IEN=$O(^ORD(101.41,MNU,10,"B",SEQ,IEN)) Q:'IEN D
  1. . . S X=$G(^ORD(101.41,MNU,10,IEN,0)),ITM=+$P(X,U,2),TXT=$P(X,U,4)
  1. . . S X=$G(^ORD(101.41,ITM,5)),FID=+$P(X,U,5)
  1. . . S X=$G(^ORD(101.41,ITM,0)),TYP=$P(X,U,4),DGRP=+$P(X,U,5)
  1. . . S:'$L(TXT) TXT=$P(X,U,2)
  1. . . I TYP="M" S:'FID FID=1001
  1. . . S LST(SEQ)=ITM_";"_FID_";"_DGRP_";"_TYP_U_TXT
  1. Q
  1. DELPI ; delete PI from ORDIALOG if PI = ""
  1. ;Called from SAVE^ORWDX
  1. N ORPI S ORPI=0
  1. S ORPI=$O(^ORD(101.41,"B","OR GTX PATIENT INSTRUCTIONS",ORPI))
  1. Q:'$D(ORDIALOG(ORPI)) ;ORDIALOG is passed into SAVE^ORWDX which calls this section
  1. I '$D(ORDIALOG(ORPI,1)) K ORDIALOG(ORPI),ORDIALOG("WP",ORPI) Q
  1. N PINODE,PITX
  1. S PITX="",PINODE=$G(ORDIALOG(ORPI,1))
  1. S PITX=$G(@PINODE@(1,0))
  1. S PITX=$TR(PITX," ","")
  1. I '$L(PITX) K ORDIALOG(ORPI),ORDIALOG("WP",ORPI) Q
  1. N ORSIG S ORSIG=+$O(^ORD(101.41,"B","OR GTX SIG",0))
  1. I $$STR^ORWDXR(ORSIG)[$$STR^ORWDXR(ORPI) S ORDIALOG(ORPI,"FORMAT")="@"
  1. Q
  1. FNDINFO(Y,ODIEN) ;
  1. N ODI,CRTM,FRM,XX
  1. S FRM="",CRTM=$$NOW^XLFDT
  1. F S FRM=$O(^ORD(101.43,XRF,FRM)) Q:FRM="" D
  1. . S ODI=0 F S ODI=$O(^ORD(101.43,XRF,FRM,ODI)) Q:'ODI D
  1. .. S XX=^ORD(101.43,XRF,FRM,ODI) ;XRF NEW'd in ORWDX which calls this section
  1. .. I +$P(XX,U,3),$P(XX,U,3)<CRTM Q
  1. .. I ODI=ODIEN D
  1. ... S NM=NM+1 ;variable NEW'd in ORWDX which calls this section
  1. ... I 'XX S Y(NM)=ODIEN_U_$P(XX,U,2)_U_$P(XX,U,2)
  1. ... E S Y(NM)=ODIEN_U_$P(XX,U,2)_$C(9)_"<"_$P(XX,U,4)_">"_U_$P(XX,U,4)
  1. Q
  1. DLGDEF(LST,DLG) ; Format mapping for a dlg
  1. N I,IEN,ILST,X0,X2,XW S ILST=0
  1. I $O(^ORD(101.41,"AB",DLG,0))>0 S DLG=$O(^ORD(101.41,"AB",DLG,0))
  1. E S DLG=$O(^ORD(101.41,"B",DLG,0))
  1. Q:'DLG
  1. S I=0 F S I=$O(^ORD(101.41,DLG,10,I)) Q:I'>0 D
  1. . S X0=$G(^ORD(101.41,DLG,10,I,0)),X2=$G(^(2)),IEN=+$P(X0,U,2)
  1. . S ILST=ILST+1,LST(ILST)=U_IEN_U_$P(X2,U,1,7)
  1. . I $P(X0,U,11) S $P(LST(ILST),U,11)=1
  1. . S $P(LST(ILST),U)=$P($G(^ORD(101.41,IEN,1)),U,3)
  1. . I $P($G(^ORD(101.41,IEN,0)),U)="OR GTX ADDITIVE" S $P(LST(ILST),U)="ADDITIVE"
  1. . I $P($G(^ORD(101.41,IEN,0)),U)="OR GTX ADDL DIETS" S $P(LST(ILST),U)="ADDLDIETS"
  1. . I $L($P(LST(ILST),U))=0 S $P(LST(ILST),U)="ID"_IEN
  1. . I $D(^ORD(101.41,DLG,10,"DAD",IEN)) D
  1. .. N SEQ,DA,CHILD S CHILD=""
  1. .. S SEQ=0 F S SEQ=$O(^ORD(101.41,DLG,10,"DAD",IEN,SEQ)) Q:'SEQ D
  1. ... S DA=0 F S DA=$O(^ORD(101.41,DLG,10,"DAD",IEN,SEQ,DA)) Q:'DA D
  1. .... S CHILD=CHILD_+$P($G(^ORD(101.41,DLG,10,DA,0)),U,2)_"~"
  1. .. S $P(LST(ILST),U,10)=CHILD
  1. Q
  1. ;
  1. CHANGE(ORLST,ORCLST,DFN,ISIMO) ;
  1. N CATCH,CHANGE,CNT,INP,INPDIEN,IVM,IVMDIEN,ORIEN,ORLOC,OR3,ORDG
  1. N CIEN,CIVIEN,DIAL,TDIAL,TIEN,UDIEN,QORDDG,PACKIEN
  1. S (INP,IVM,INPDIEN,IVMDIEN,UDIEN)=0
  1. S (TDIAL,TIEN,CIEN,CIVIEN)=0
  1. S INP=$O(^ORD(101.41,"B","PSJ OR PAT OE","")) Q:INP'>0
  1. S IVM=$O(^ORD(101.41,"B","PSJI OR PAT FLUID OE","")) Q:IVM'>0
  1. S TDIAL=$O(^ORD(101.41,"B","OR GXTEXT WORD PROCESSING ORDER","")) Q:TDIAL'>0
  1. S INPDIEN=$O(^ORD(100.98,"B","INPATIENT MEDICATIONS","")) Q:INPDIEN'>0
  1. S IVMDIEN=$O(^ORD(100.98,"B","IV MEDICATIONS","")) Q:IVMDIEN'>0
  1. S UDIEN=$O(^ORD(100.98,"B","UNIT DOSE MEDICATIONS","")) Q:UDIEN'>0
  1. S TIEN=$O(^ORD(100.98,"B","NURSING","")) Q:TIEN'>0
  1. S CIEN=$O(^ORD(100.98,"B","CLINIC MEDICATIONS","")) Q:CIEN'>0
  1. S CIVIEN=$O(^ORD(100.98,"B","CLINIC INFUSIONS","")) Q:CIEN'>0
  1. S CNT=0 F S CNT=$O(ORCLST(CNT)) Q:CNT'>0 D
  1. .S CHANGE=0
  1. .S ORIEN=$P($G(ORCLST(CNT)),U),ORIEN=$P(ORIEN,";")
  1. .S ORDG=$P($G(^OR(100,ORIEN,0)),U,11)
  1. .S ORLOC=$P($G(ORCLST(CNT)),U,2)
  1. .S OR3=$G(^OR(100,ORIEN,3))
  1. .S DIAL=$P(OR3,U,4)
  1. .;Remove Treating Speciality if the order location is the clinic
  1. .I $P($G(^OR(100,ORIEN,0)),U,10)=(ORLOC_";SC("),$P($G(^SC(ORLOC,0)),U,3)="C" D Q
  1. ..S $P(^OR(100,ORIEN,0),U,13)=""
  1. .;
  1. .;CHANGE PATIENT LOCATION AND PATIENT STATUS.
  1. .S $P(^OR(100,ORIEN,0),U,10)=ORLOC_";SC("
  1. .S PACKIEN=$P(^OR(100,ORIEN,0),U,14)
  1. .I $$GET1^DIQ(9.4,PACKIEN_",",1)'="PSO" S $P(^OR(100,ORIEN,0),U,12)="I"
  1. .;
  1. .;Check for IMO orders Nursing Dialog problem
  1. .S CATCH=$P($G(^OR(100,ORIEN,0)),U,11)
  1. .;
  1. .S $P(^OR(100,ORIEN,0),U,11)=$S(DIAL=(IVM_";ORD(101.41,"):IVMDIEN,DIAL=(INP_";ORD(101.41,"):UDIEN,DIAL=(TDIAL_";ORD(101.41,"):TIEN,1:CATCH)
  1. .;
  1. .;Check for Quick Order Dialog
  1. .I CATCH=$P($G(^OR(100,ORIEN,0)),U,11),ISIMO=1 D
  1. ..S QORDDG=$P($G(^ORD(101.41,+DIAL,0)),U,5)
  1. ..I QORDDG=UDIEN!(QORDDG=INPDIEN) S $P(^OR(100,ORIEN,0),U,11)=UDIEN,DIAL=(INP_";ORD(101.41,") Q
  1. ..I QORDDG=IVMDIEN S $P(^OR(100,ORIEN,0),U,11)=IVMDIEN,DIAL=(IVM_";ORD(101.41,") Q
  1. ..I QORDDG=TIEN S $P(^OR(100,ORIEN,0),U,11)=TIEN,DIAL=(TDIAL_";ORD(101.41,") Q
  1. .;
  1. .;Add treating spec if Inpatient order
  1. .;I (ISIMO=1)&(DIAL=(IVM_";ORD(101.41,"))!(DIAL=(INP_";ORD(101.41,")) D
  1. .;.S $P(^OR(100,ORIEN,0),U,13)=+$G(^DPT(DFN,.103))
  1. .I ISIMO=0 S $P(^OR(100,ORIEN,0),U,13)=+$G(^DPT(DFN,.103))
  1. Q
  1. ;
  1. STCHANGE(ORY,DFN,ORYARR) ;
  1. N CNT,DONE,NODE,PHARMID,STR,STATUS
  1. S ORY=0,DONE=0
  1. I '$$PATCH^XPDUTL("PSS*1.0*93") Q
  1. S CNT=0 F S CNT=$O(ORYARR(CNT)) Q:CNT'>0!(DONE>0) D
  1. . S NODE=$G(ORYARR(CNT))
  1. . S PHARMID=$P(NODE,U),STATUS=$P(NODE,U,2)
  1. . I $$UP^XLFSTR(STATUS)'=$$STATUS^PSSORUTE(DFN,PHARMID) S ORY=1,DONE=1
  1. Q
  1. ORDMATCH(ORY,DFN,ORYARR) ;
  1. N ACTION,CNT,IEN,MATCH,ORDERID,STATUS
  1. S CNT=0,MATCH=1
  1. F S CNT=$O(ORYARR(CNT)) Q:CNT'>0!(MATCH=0) D
  1. . S ORDERID=$P(ORYARR(CNT),U),STATUS=$P(ORYARR(CNT),U,2)
  1. . ;*341 Set up Action before validation.
  1. . S IEN=$P(ORDERID,";"),ACTION=$P(ORDERID,";",2)
  1. . I ORDERID=0,$G(ACTION)="" Q
  1. . I STATUS=$P($G(^OR(100,IEN,3)),U,3) Q
  1. . I $P($G(^ORD(100.01,STATUS,0)),U)="DISCONTINUED/EDIT" Q
  1. . ;S MATCH=0
  1. . I $P($G(^OR(100,IEN,8,ACTION,0)),U,15)'=STATUS S MATCH=0
  1. S ORY=MATCH
  1. Q
  1. ;
  1. DCREN(ORY,ORYARR) ;
  1. N ACT,CNT,CNT1,I,OR3,ORG,ORGID,ORID,TEXT,STATUS
  1. S CNT1=0
  1. S CNT=0 F S CNT=$O(ORYARR(CNT)) Q:CNT'>0 D
  1. .S ORGID=ORYARR(CNT)
  1. .S ORID=+ORGID,ACT=$P(ORGID,";",2),TEXT=""
  1. .S OR3=$G(^OR(100,ORID,3))
  1. .;Make sure current order status is pending
  1. .I $P($G(^ORD(100.01,$P(OR3,U,3),0)),U)'="PENDING" Q
  1. .S ORG=$P($G(OR3),U,5) Q:ORG'>0
  1. .;do not add original order if it is expired
  1. .S STATUS=$P(^OR(100,ORG,3),U,3)
  1. .I $P($G(^ORD(100.01,STATUS,0)),U)="EXPIRED" Q
  1. .;Do not add original order if Stop date has pass
  1. .I $P(^OR(100,ORG,0),U,9)'>$$NOW^XLFDT Q
  1. .;make sure current order is a renewed order
  1. .I $P(OR3,U,11)'=2 Q
  1. .S ACT=+$P($G(^OR(100,ORG,3)),U,7)
  1. .S CNT1=CNT1+1,ORY(CNT1)=ORGID_U_$P(OR3,U,5)_";"_ACT_U_TEXT
  1. Q
  1. DCORIG(ORY,ORIEN) ;
  1. S $P(^OR(100,+ORIEN,6),U,9)=1
  1. Q
  1. UNDCORIG(ORY,ORYARR) ;
  1. N CNT
  1. S CNT=0 F S CNT=$O(ORYARR(CNT)) Q:CNT'>0 S $P(^OR(100,+ORYARR(CNT),6),U,9)=0
  1. Q
  1. PATWARD(ORY,DFN) ;
  1. N TEMP
  1. S ORY=""
  1. I $G(^DPT(DFN,.1))="" Q
  1. S TEMP=^DPT(DFN,.1)
  1. S ORY=TEMP_U_+$G(^DIC(42,+$O(^DIC(42,"B",TEMP,0)),44))
  1. Q
  1. ;
  1. ISPEND(ORIFN) ;Is the order's status pending?
  1. N ISPEND,PENDST,N3 S ISPEND=0
  1. Q:'$D(^OR(100,+ORIFN,3))
  1. S PENDST=$O(^ORD(100.01,"B","PENDING",0))
  1. S N3=$G(^OR(100,+ORIFN,3))
  1. I $P(N3,U,3)=PENDST S ISPEND=1
  1. Q ISPEND