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

ORY141ED.m

Go to the documentation of this file.
  1. ORY141ED ; SLC/MKB - EDO inits for patch OR*3*141 ;8/19/02 10:45
  1. ;;3.0;ORDER ENTRY/RESULTS REPORTING;**141**;Dec 17, 1997
  1. ;
  1. PRE ; -- preinit: remove old DD's
  1. Q:$O(^ORD(101,"B","ORC DELAYED ORDERS",0)) ;not 1st install
  1. N DIU,ORNOW,XMDUZ,XMDUN,XMY,X,XMOUT
  1. S DIU="^OR(100.2,",DIU(0)="DST" D EN^DIU2 ;remove old DD
  1. D DELIX^DDMOD(100,.02,4),DELIX^DDMOD(100,15,1) ;remove old AEVNT xrefs
  1. S ORNOW=$$NOW^XLFDT K ^XTMP("ORYED")
  1. S ^XTMP("ORYED",0)=$$FMADD^XLFDT(ORNOW,90)_U_ORNOW_"^OR*3*141 Delay Event Conversion"
  1. W !!,"A mail message will be generated when the post-init conversion has completed."
  1. S XMDUZ=DUZ,XMDUN=$P($G(^VA(200,DUZ,0)),U) D DEST^XMA21
  1. I $D(XMOUT) W !!,$C(7),"Only the installer of this patch will receive the conversion bulletin!" S XMY(DUZ)=""
  1. M ^XTMP("ORYED","XMY")=XMY
  1. Q
  1. ;
  1. DLGSEND(X) ; -- Send order dialog X?
  1. I X="LR OTHER LAB TESTS" Q 1
  1. I X="RA OERR EXAM" Q 1
  1. I X="PS MEDS" Q 1
  1. I X="PSJ OR PAT OE" Q 1
  1. I X="PSO OERR" Q 1
  1. I X="PSO SUPPLY" Q 1
  1. I X="OR GXMOVE ADMIT PATIENT" Q 1
  1. I X="OR GXMOVE DISCHARGE" Q 1
  1. I X="OR GXMOVE TRANSFER" Q 1
  1. I X="OR GXMOVE TREATING SPECIALTY" Q 1
  1. Q 0
  1. ;
  1. POST ; -- postinit: convert orders, remove old parameters
  1. S ^ORD(100.01,10,.1)="dly"
  1. S ^ORD(100.01,13,1,1,0)="Orders that have been rejected by the ancillary service without being"
  1. S ^ORD(100.01,13,1,2,0)="acted on, or terminated while still delayed."
  1. K ^DIC(100.5,0,"RD"),^DIC(100.6,0,"RD") ;remove read access
  1. D 101,AEVNT,PARAMS,DLGS,C
  1. Q
  1. ;
  1. AEVNT ; -- postinit: convert Event field #15 of Orders file #100
  1. ; from code (A/D/T) to pointer to #100.2
  1. ; (incl a report of bad data, lapsed orders)
  1. ;
  1. Q:'$D(^XTMP("ORYED","XMY")) ;not 1st install
  1. N ORPARAM,ORLAPSE,ORSITE,ORVP,ORDIED,OREVT,ORIFN,OR0,OR3,ORTS,ORL,ORDIV,ORX,ORNOW,ORPTEVT
  1. S ORPARAM=+$$GET^XPAR("ALL","OR DELAYED ORDERS LAPSE DAYS"),ORLAPSE=0
  1. S:ORPARAM ORLAPSE=$$FMADD^XLFDT(DT,(0-ORPARAM)) ;=0 or cutoff date
  1. S ORNOW=$$NOW^XLFDT,ORSITE=+$$SITE^VASITE ;[primary] division
  1. S ORVP="" F S ORVP=$O(^OR(100,"AEVNT",ORVP)) Q:ORVP="" D
  1. . S ORL="",ORDIED=+$G(^DPT(+ORVP,.35)) I $L($G(^(.1))) S ORL=+$O(^DIC(42,"B",^(.1),0)),ORL=$G(^DIC(42,ORL,44))
  1. . F OREVT="A","T","D" S ORIFN=0 D
  1. .. F S ORIFN=+$O(^OR(100,"AEVNT",ORVP,OREVT,ORIFN)) Q:ORIFN<1 D
  1. ... S OR0=$G(^OR(100,ORIFN,0)),OR3=$G(^(3)) I '$L($P(OR0,U,17)) D CLEAR Q
  1. ... S ORX=$P(OR0,U,10) S:'ORX ORX=ORL
  1. ... S ORDIV=$$DIV^OREVNTX(ORX) S:ORDIV<1 ORDIV=ORSITE
  1. ... I $P(OR3,U,3)'=10 D CLEAR,ERR(1) Q ;discharge meds
  1. ... S ORTS=+$P(OR0,U,13) I OREVT'="D",ORTS<1 D STATUS^ORCSAVE2(ORIFN,13),CLEAR,ERR(2) Q ;error
  1. ... I $P(OR0,U,7)<ORLAPSE D STATUS^ORCSAVE2(ORIFN,14),CLEAR,ERR(3) Q
  1. ... I ORDIED D CANCEL,CLEAR,ERR(4) Q
  1. ... S ORX=OREVT_U_$S(OREVT'="D":ORTS,1:"")_U_ORDIV
  1. ... S ^XTMP("ORYED","EVT",ORX)="",^(ORX,ORVP)="",^(ORVP,ORIFN)=""
  1. Q:'$L($O(^XTMP("ORYED","EVT",""))) ;no delayed orders to convert
  1. AE1 S ORX="" F S ORX=$O(^XTMP("ORYED","EVT",ORX)) Q:ORX="" D
  1. . S OREVT=$$EVENT(ORX) Q:OREVT<1 S ^XTMP("ORYED","EVT",ORX)=OREVT
  1. . S ORVP="" F S ORVP=$O(^XTMP("ORYED","EVT",ORX,ORVP)) Q:ORVP="" D
  1. .. S ORPTEVT=$$NEW^OREVNT(+ORVP,+OREVT) Q:ORPTEVT<1
  1. .. S ^XTMP("ORYED","EVT",ORX,ORVP)=ORPTEVT D SET(ORVP,ORX,OREVT)
  1. .. S ORIFN=0 F S ORIFN=+$O(^XTMP("ORYED","EVT",ORX,ORVP,ORIFN)) Q:ORIFN<1 D
  1. ... S $P(^OR(100,ORIFN,0),U,17)=ORPTEVT
  1. ... K ^OR(100,"AEVNT",ORVP,$P(ORX,U),ORIFN)
  1. ... S ^OR(100,"AEVNT",ORVP,ORPTEVT,ORIFN)=""
  1. D BULLETIN K ^XTMP("ORYED","XMY")
  1. Q
  1. ;
  1. CANCEL ; -- Cancel order for deceased patient
  1. S ^OR(100,ORIFN,6)=$O(^ORD(100.02,"C","A",0))_U_U_ORNOW_U_+$O(^ORD(100.03,"C","ORDEATH",0))
  1. D STATUS^ORCSAVE2(ORIFN,13) S $P(^OR(100,ORIFN,8,1,0),U,15)=13
  1. Q
  1. ;
  1. CLEAR ; -- Clear Event code field
  1. S $P(^OR(100,ORIFN,0),U,17)="" S:$P($G(^(8,1,0)),U,15)=10 $P(^(0),U,15)=""
  1. K ^OR(100,"AEVNT",ORVP,OREVT,ORIFN)
  1. Q
  1. ;
  1. EVENT(X) ; -- Find (or create) event in #100.5 for
  1. ; X = A/D/T ^ [TS] ^ DIV ptr
  1. N I,Y,TS,DIV,ORY,X0,MVT,ORGLOB
  1. S TS=+$P(X,U,2),DIV=+$P(X,U,3),X=$P(X,U),Y=0 K ORY
  1. S I=0 F S I=+$O(^ORD(100.5,"ADT",X,I)) Q:I<1 D ;find matches
  1. . S X0=$G(^ORD(100.5,I,0)) Q:DIV'=$P(X0,U,3)
  1. . I TS Q:'$O(^ORD(100.5,I,"TS","B",TS,0))
  1. . S MVT=+$P(X0,U,7) I MVT Q:$S(X="A":MVT'=15,X="T":MVT'=4,1:MVT'=16)
  1. . S ORY(+$G(^ORD(100.5,I,1)),MVT,I)="" ;=ORY(InactDt,MvtType,IEN)
  1. S I="ORY",I=$Q(@I),Y=+$P(I,",",3)
  1. I Y<1 D ;create new inactive event
  1. . N I,HDR,LAST,TOTAL,DA,NAME
  1. . F I=1:1:10 L +^ORD(100.5,0):1 Q:$T H 2
  1. . I '$T S Y="" Q
  1. . S HDR=$G(^ORD(100.5,0)),TOTAL=$P(HDR,U,4),LAST=$O(^ORD(100.5,"?"),-1)
  1. . S I=LAST F I=(I+1):1 Q:'$D(^ORD(100.5,I,0))
  1. . S Y=I,$P(HDR,U,3,4)=Y_U_(TOTAL+1)
  1. . S ^ORD(100.5,0)=HDR L -^ORD(100.5,0)
  1. . S NAME=$S(X="A":"ADMIT",X="T":"TRANSFER",X="D":"DISCHARGE",1:"")_$S(TS:" TO "_$P($G(^DIC(45.7,+TS,0)),U),1:"")_" ("_DIV_")"
  1. . S ^ORD(100.5,Y,0)=NAME_U_X_U_DIV_"^^^"_ORPARAM_"^^"_NAME,^(1)=ORNOW
  1. . S ^ORD(100.5,"B",$E(NAME,1,30),Y)="",^ORD(100.5,"ADT",X,Y)=""
  1. . I TS S ^ORD(100.5,Y,"TS",0)="^100.51P^1^1",^(1,0)=TS,^ORD(100.5,Y,"TS","B",TS,1)=""
  1. . S ORGLOB="^ORD(100.5," D AUDIT^OREV(Y,"N") ;Set edit history for new rule
  1. Q Y
  1. ;
  1. ERR(X) ; -- Track orders unable to convert
  1. N MSG,STS S X=+$G(X),STS=$P(OR3,U,3)
  1. S MSG=$S(X=2:"<Missing or invalid specialty>",X=3!(STS=14):"<Lapsed>",STS=12:"<Changed>",STS=1!(STS=13):"<Cancelled>",1:"<Already released>")
  1. S ^XTMP("ORYED","ERR",ORVP,ORIFN)=OREVT_U_$G(ORTS)_U_MSG
  1. ; Include missing TS, newly lapsed orders in bulletin:
  1. ;D:X>1 SET(ORVP,OREVT_U_$G(ORTS)_U_ORDIV,MSG)
  1. Q
  1. ;
  1. SET(PAT,OLD,NEW) ; -- set xref nodes in XTMP for bulletin
  1. N PNM,EVT,DIV,DIVNM,TS,NEWNM
  1. S PNM=$P($G(^DPT(+PAT,0)),U)_" ("_$P($G(^(.36)),U,4)_")"
  1. S EVT=$P(OLD,U) S:EVT="D" TS="none" I "AT"[EVT D
  1. . S TS=$P(OLD,U,2),X0=$S(TS:$G(^DIC(45.7,+TS,0)),1:"unk")
  1. . S TS=$S($L($P(X0,U,5)):$P(X0,U,5),1:$E($P(X0,U),1,5))
  1. S DIV=+$P(OLD,U,3),DIVNM=$S(DIV:$P($G(^DIC(4,DIV,0)),U),1:"UNKNOWN")
  1. S NEWNM=$S(NEW:$P($G(^ORD(100.5,+NEW,0)),U),1:NEW) ;EvtNm or ErrMsg
  1. S ^XTMP("ORYED","B",DIVNM,EVT,TS)=NEWNM,^(TS,PNM)=OLD_"~"_PAT
  1. Q
  1. ;
  1. BULLETIN ; -- send bulletin when finished
  1. N DIFROM,XMSUB,XMTEXT,XMDUZ,XMY,XMZ,XMMG,I,J,ORZ,DIV,EVT,TS,NEWEVT,X,PAT,ORX,ORVP,ORIFN,ORDERS,MAX
  1. S XMDUZ="PATCH OR*3*141 CONVERSION",XMY(.5)="" S:$G(DUZ) XMY(DUZ)=""
  1. I $D(^XTMP("ORYED","XMY")) M XMY=^XTMP("ORYED","XMY") ;recipients
  1. S ^TMP("ORTXT",$J,1)="The Delayed Order conversion of patch OR*3*141 has completed."
  1. B1 S I=1 I $D(^XTMP("ORYED","B")) D
  1. . S I=I+1,^TMP("ORTXT",$J,I)=" "
  1. . S I=I+1,^TMP("ORTXT",$J,I)="The following patients had delayed orders at the time of installation."
  1. . S I=I+1,^TMP("ORTXT",$J,I)="For each, any event codes and treating specialties formerly in use are"
  1. . S I=I+1,^TMP("ORTXT",$J,I)="listed on the left, with the new entry it was mapped to in the OE/RR"
  1. . S I=I+1,^TMP("ORTXT",$J,I)="RELEASE EVENTS file #100.5, if possible, on the right:"
  1. . S DIV="" F S DIV=$O(^XTMP("ORYED","B",DIV)) Q:DIV="" D
  1. .. S I=I+1,^TMP("ORTXT",$J,I)=" "
  1. .. S I=I+1,^TMP("ORTXT",$J,I)=DIV_":",ORZ=$$REPEAT^XLFSTR("-",$L(DIV))
  1. .. F EVT="A","T","D" S TS="" F S TS=$O(^XTMP("ORYED","B",DIV,EVT,TS)) Q:TS="" S NEWEVT=$G(^(TS)) D
  1. ... S I=I+1,^TMP("ORTXT",$J,I)=ORZ,ORZ=" "
  1. ... S X=$S(EVT="D":"DISCHARGE",1:EVT_"/"_TS)
  1. ... S I=I+1,^TMP("ORTXT",$J,I)=$$LJ^XLFSTR(X,9)_" => "_NEWEVT
  1. ... S PAT="" F S PAT=$O(^XTMP("ORYED","B",DIV,EVT,TS,PAT)) Q:PAT="" S ORX=$G(^(PAT)) D
  1. .... S ORVP=$P(ORX,"~",2),ORX=$P(ORX,"~"),MAX=68-$L(PAT)
  1. .... S (ORIFN,ORDERS)=0,X="#"
  1. .... F S ORIFN=+$O(^XTMP("ORYED","EVT",ORX,ORVP,ORIFN)) Q:ORIFN<1 D
  1. ..... I $L(X)+$L(ORIFN)+1'>MAX S X=X_$S($L(X)>1:",",1:"")_ORIFN Q
  1. ..... S ORDERS=ORDERS+1,ORDERS(ORDERS)=X_",",X=ORIFN
  1. .... S ORDERS=ORDERS+1,ORDERS(ORDERS)=X,X=" "_PAT_": "
  1. .... F J=1:1:ORDERS S I=I+1,^TMP("ORTXT",$J,I)=X_ORDERS(J),X=" "
  1. S XMSUB="PATCH OR*3*141 CONVERSION COMPLETED"
  1. S XMTEXT="^TMP(""ORTXT"","_$J_"," D ^XMD
  1. K ^TMP("ORTXT",$J)
  1. Q
  1. ;
  1. PARAMS ; -- Remove old parameters, template
  1. ;
  1. N DA,DIK,ORI
  1. S DIK="^XTV(8989.52,",DA=+$O(^XTV(8989.52,"B","ORP AUTODC ORDERS",0)) D:DA ^DIK
  1. F ORI="OR DC GEN ORD ON ADMISSION","ORPF DC OF GENERIC ORDERS","OR DC ON SPEC CHANGE","OR DELAYED ORDERS LAPSE DAYS" D
  1. . S DIK="^XTV(8989.51,",DA=+$O(^XTV(8989.51,"B",ORI,0))
  1. . D:DA ^DIK
  1. Q
  1. ;
  1. DLGS ; -- Send bulletin re modified dialogs
  1. N I,ORD
  1. F I="LR OTHER LAB TESTS","RA OERR EXAM","PS MEDS","PSJ OR PAT OE","PSO OERR","PSO SUPPLY","OR GXMOVE ADMIT PATIENT","OR GXMOVE DISCHARGE","OR GXMOVE TRANSFER","OR GXMOVE TREATING SPECIALTY" S ORD(I)=""
  1. D EN^ORYDLG(141,.ORD)
  1. Q
  1. ;
  1. 101 ; -- replace items on protocol menus
  1. N ORI,ORX,ORMENU,OROLD,ORNEW,ORMNEM,DA,DR,DIE,X,Y
  1. F ORI=1:1 S ORX=$T(PRTCLS+ORI) Q:ORX["ZZZZZ" D
  1. . S ORMENU=+$O(^ORD(101,"B",$P(ORX,";",3),0)) Q:ORMENU<1
  1. . S OROLD=+$O(^ORD(101,"B",$P(ORX,";",4),0)) Q:OROLD<1
  1. . S DA=+$O(^ORD(101,ORMENU,10,"B",OROLD,0)) Q:DA<1 ;already fixed
  1. . S ORNEW=$P(ORX,";",5),ORMNEM=$P(ORX,";",6)
  1. . S DIE="^ORD(101,"_ORMENU_",10,",DA(1)=ORMENU
  1. . S DR=".01///^S X=ORNEW;2///^S X=ORMNEM;5///@;6///@" D ^DIE
  1. Q
  1. ;
  1. PRTCLS ;;MENU;REPL;WITH;MNEMONIC
  1. ;;ORCHART ORDERS MENU;ORB BLANK LINE1;ORC DELAYED ORDERS;TD
  1. ;;ORC ADD ORDERS MENU;ORC EVENT MENU;VALM PREVIOUS SCREEN;-
  1. ;;ZZZZZ
  1. ;
  1. C ; -- Rebuild C index on #100.5 to uppercase
  1. N X,X1,DA K ^TMP($J,"ORD100.5C")
  1. S X="" F S X=$O(^ORD(100.5,"C",X)) Q:X="" D
  1. . S X1=$$UP^XLFSTR(X),DA=0
  1. . F S DA=$O(^ORD(100.5,"C",X,DA)) Q:DA<1 S ^TMP($J,"ORD100.5C",X1,DA)=""
  1. K ^ORD(100.5,"C") M ^ORD(100.5,"C")=^TMP($J,"ORD100.5C")
  1. K ^TMP($J,"ORD100.5C")
  1. Q