ORIN1009 ;IHS/CIA/PLS - KIDS Inits for OR patch 1009 ;28-Oct-2011 08:40;DKM
;;3.0;ORDER ENTRY/RESULTS REPORTING;**1009**;Dec 17, 1997
;=================================================================
EC ;EP - Environment check
Q
PRE ;EP - Preinit
Q
POST ;EP - Postinit
D CHGODDM("OR GTX DAYS SUPPLY","1:365")
D CHGODDM("OR GTX QUANTITY",".01:99999999.99:3")
N PKG
F PKG="OUTPATIENT PHARMACY","PHARMACY DATA MANAGEMENT" D
.D ADDPMT("OR GTX SSDENYRSN",PKG,"Reason to Deny:","Reason to Deny",7.4,99.3,"@")
Q
;
CHGPSO ;EP-
N DNM
F DNM="PSO OERR","LR OTHER LAB TESTS" D CHKPSO1(DNM)
Q
CHKPSO1(DNM) ;EP-
N DLG,PMT,IEN,FDA
S DLG=$$FIND1^DIC(101.41,,"XQ",DNM)
S PMT=$$FIND1^DIC(101.41,,"XQ","OR GTX CLININD")
Q:'PMT!'DLG
S IEN=$O(^ORD(101.41,DLG,10,"D",PMT,0))
Q:'IEN
S FDA(101.412,IEN_","_DLG_",",9)="@"
D FILE^DIE("","FDA")
Q
; Change domain value of given order dialog
CHGODDM(DLGNM,DMVAL) ;EP-
N DLG,FDA
S DLG=$$FIND1^DIC(101.41,,"XQ",DLGNM)
Q:'DLG
S FDA(101.41,DLG_",",12)=DMVAL
D FILE^DIE("","FDA")
Q
; Add a report to the ORRPW ADT VISITS report header.
ADDCHILD(RPT) ;
N X,Y,FDA
S X=$$FIND1^DIC(101.24,,"X","ORRPW ADT VISITS")
S Y=$$FIND1^DIC(101.24,,"X",RPT)
I X,Y D
.S:'$O(^ORD(101.24,X,10,"B",Y,0)) FDA(101.241,"+1,"_X_",",.01)="`"_Y
.S FDA(101.24,Y_",",.13)="ORWRP REPORT TEXT"
.D UPDATE^DIE("E","FDA")
Q
; Add prompt to selected order and quick order dialogs
ADDPMT(PMT,PKG,LBL,DX,SEQ,OTS,FMT,REQ) ;
N DLG,TYP,ITM,QO,X,Y
S REQ=$G(REQ,1)
S:PMT'=+PMT PMT=$$FIND1^DIC(101.41,,"XQ",PMT)
S:PKG'=+PKG PKG=$$FIND1^DIC(9.4,,"XQ",PKG)
Q:'PMT!'PKG
S QO='OTS,TYP=$S(QO:"Q",1:"D"),ITM=0,FMT=$G(FMT)
F DLG=0:0 S DLG=$O(^ORD(101.41,DLG)) Q:'DLG S X=$G(^(DLG,0)) D
.N FDA,IEN,NAM,SUB,SFN
.Q:$P(X,U,4)'=TYP
.S Y=$P(X,U,7)
.I 'Y,QO D
..S Y=$P(X,U,5)
..S:Y Y=$P($G(^ORD(100.98,Y,0)),U,4)
..S:Y Y=$P($G(^ORD(101.41,Y,0)),U,7)
.Q:Y'=PKG
.S SUB=$S(QO:6,1:10),SFN=$S(QO:101.416,1:101.412)
.Q:'$O(^ORD(101.41,DLG,SUB,"D",0))
.S IEN=$O(^ORD(101.41,DLG,SUB,"D",PMT,0))
.S NAM=$$GET1^DIQ(101.41,DLG,.01)
.S FDA=$NA(FDA(SFN,$S(IEN:IEN,1:"+1")_","_DLG_","))
.D ADDQO:QO,ADDDG:'QO
.D UPDATE^DIE("","FDA","IEN")
.S X=$S(IEN:IEN,1:+$G(IEN(1)))
.S:'ITM ITM=X
.D BMES^XPDUTL($S(IEN:"Updated ",X:"Added ",1:"Unable to add ")_DX_" prompt "_$S(IEN:"in ",1:"to ")_NAM_".")
I 'QO,ITM D ADDPMT(PMT,PKG,LBL,DX,ITM,0)
Q
ADDDG S @FDA@(.01)=SEQ
S @FDA@(2)=PMT
S @FDA@(6)=REQ ;required field
S @FDA@(9)="*"
S @FDA@(17)="S Y="""""
S:OTS>0 @FDA@(21)=OTS
S:$L(FMT) @FDA@(22)=FMT
S @FDA@(24)=LBL
Q
ADDQO S @FDA@(.01)=SEQ
S @FDA@(.02)=PMT
S @FDA@(.03)=1
Q
; Change Mixed Name field value for Display Group
CHGMXNM(DSPGRP,MXNM) ;
N FDA,IEN
Q:'$L($G(DSPGRP))!('$L($G(MXNM)))
S IEN=$$FIND1^DIC(100.98,,"XQ",DSPGRP)
Q:'IEN
S FDA(100.98,IEN_",",2)=MXNM
D FILE^DIE("","FDA")
Q
; Remove ORPF GRACE DAYS BEFORE PURGE parameter from
; ORP ORDER MISC parameter template
REMPRG N PAR,TPL,LP,FDA
S PAR=$$FIND1^DIC(8989.51,,"XQ","ORPF GRACE DAYS BEFORE PURGE")
S TPL=$$FIND1^DIC(8989.52,,"XQ","ORP ORDER MISC")
Q:'PAR!'TPL
F LP=0:0 S LP=$O(^XTV(8989.52,TPL,10,LP)) Q:'LP D:$P($G(^(LP,0)),U,2)=PAR
.S FDA(8989.521,LP_","_TPL_",",.01)="@"
D:$D(FDA) FILE^DIE("","FDA")
Q
;
; File entry
STORE(FDA) ;EP
N MSG
D UPDATE^DIE(,"FDA",,"MSG")
I $D(MSG) D
.W !,"The following error occurred:"
.W !,$G(MSG("DIERR",1,"TEXT",1))
.S XPDQUIT=1
K FDA
Q
;
TRAN(VAL) ;EP - Check for entry inclusion
I "^OR GTX HM LIST SOURCE^OR GTX HM LAST DOSE TAKEN^OR GTX HM LOCATION OF MEDICATION^OR GTX HM REASON^"[X Q 1
Q 0
;
ADDRDIV ;
Q:$$FIND1^DIC(100.22,,,"REQUESTING DIVISION") ; Already exists
N FDA,FN,IEN
S IEN=$P(^ORD(100.22,0),U,3) ; Check next ien value. Set to 1 if not between 1 and 999
S:IEN>999 $P(^ORD(100.22,0),U,3)=0 ; Move range of new entries to start with 1(or the next valid ien)
S FN=100.22,IEN="+1,"
S FDA(FN,IEN,.01)="REQUESTING DIVISION"
S FDA(FN,IEN,.02)="DIV:"
S FDA(FN,IEN,.03)="TEST LOCATION"
S FDA(FN,IEN,.04)="ORPRDIV"
S FDA(FN,IEN,1)="S ORPRDIV="""" I $P($G(^OR(100,+$G(ORIFN),0)),U,10) S ORPRDIV=$P(^SC(+$P(^(0),U,10),0),U,15) I ORPRDIV'="""" S ORPRDIV=$P($G(^DG(40.8,ORPRDIV,0)),U,1)"
D STORE(.FDA)
Q
;
ORIN1009 ;IHS/CIA/PLS - KIDS Inits for OR patch 1009 ;28-Oct-2011 08:40;DKM
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**1009**;Dec 17, 1997
+2 ;=================================================================
EC ;EP - Environment check
+1 QUIT
PRE ;EP - Preinit
+1 QUIT
POST ;EP - Postinit
+1 DO CHGODDM("OR GTX DAYS SUPPLY","1:365")
+2 DO CHGODDM("OR GTX QUANTITY",".01:99999999.99:3")
+3 NEW PKG
+4 FOR PKG="OUTPATIENT PHARMACY","PHARMACY DATA MANAGEMENT"
Begin DoDot:1
+5 DO ADDPMT("OR GTX SSDENYRSN",PKG,"Reason to Deny:","Reason to Deny",7.4,99.3,"@")
End DoDot:1
+6 QUIT
+7 ;
CHGPSO ;EP-
+1 NEW DNM
+2 FOR DNM="PSO OERR","LR OTHER LAB TESTS"
DO CHKPSO1(DNM)
+3 QUIT
CHKPSO1(DNM) ;EP-
+1 NEW DLG,PMT,IEN,FDA
+2 SET DLG=$$FIND1^DIC(101.41,,"XQ",DNM)
+3 SET PMT=$$FIND1^DIC(101.41,,"XQ","OR GTX CLININD")
+4 IF 'PMT!'DLG
QUIT
+5 SET IEN=$ORDER(^ORD(101.41,DLG,10,"D",PMT,0))
+6 IF 'IEN
QUIT
+7 SET FDA(101.412,IEN_","_DLG_",",9)="@"
+8 DO FILE^DIE("","FDA")
+9 QUIT
+10 ; Change domain value of given order dialog
CHGODDM(DLGNM,DMVAL) ;EP-
+1 NEW DLG,FDA
+2 SET DLG=$$FIND1^DIC(101.41,,"XQ",DLGNM)
+3 IF 'DLG
QUIT
+4 SET FDA(101.41,DLG_",",12)=DMVAL
+5 DO FILE^DIE("","FDA")
+6 QUIT
+7 ; Add a report to the ORRPW ADT VISITS report header.
ADDCHILD(RPT) ;
+1 NEW X,Y,FDA
+2 SET X=$$FIND1^DIC(101.24,,"X","ORRPW ADT VISITS")
+3 SET Y=$$FIND1^DIC(101.24,,"X",RPT)
+4 IF X
IF Y
Begin DoDot:1
+5 IF '$ORDER(^ORD(101.24,X,10,"B",Y,0))
SET FDA(101.241,"+1,"_X_",",.01)="`"_Y
+6 SET FDA(101.24,Y_",",.13)="ORWRP REPORT TEXT"
+7 DO UPDATE^DIE("E","FDA")
End DoDot:1
+8 QUIT
+9 ; Add prompt to selected order and quick order dialogs
ADDPMT(PMT,PKG,LBL,DX,SEQ,OTS,FMT,REQ) ;
+1 NEW DLG,TYP,ITM,QO,X,Y
+2 SET REQ=$GET(REQ,1)
+3 IF PMT'=+PMT
SET PMT=$$FIND1^DIC(101.41,,"XQ",PMT)
+4 IF PKG'=+PKG
SET PKG=$$FIND1^DIC(9.4,,"XQ",PKG)
+5 IF 'PMT!'PKG
QUIT
+6 SET QO='OTS
SET TYP=$SELECT(QO:"Q",1:"D")
SET ITM=0
SET FMT=$GET(FMT)
+7 FOR DLG=0:0
SET DLG=$ORDER(^ORD(101.41,DLG))
IF 'DLG
QUIT
SET X=$GET(^(DLG,0))
Begin DoDot:1
+8 NEW FDA,IEN,NAM,SUB,SFN
+9 IF $PIECE(X,U,4)'=TYP
QUIT
+10 SET Y=$PIECE(X,U,7)
+11 IF 'Y
IF QO
Begin DoDot:2
+12 SET Y=$PIECE(X,U,5)
+13 IF Y
SET Y=$PIECE($GET(^ORD(100.98,Y,0)),U,4)
+14 IF Y
SET Y=$PIECE($GET(^ORD(101.41,Y,0)),U,7)
End DoDot:2
+15 IF Y'=PKG
QUIT
+16 SET SUB=$SELECT(QO:6,1:10)
SET SFN=$SELECT(QO:101.416,1:101.412)
+17 IF '$ORDER(^ORD(101.41,DLG,SUB,"D",0))
QUIT
+18 SET IEN=$ORDER(^ORD(101.41,DLG,SUB,"D",PMT,0))
+19 SET NAM=$$GET1^DIQ(101.41,DLG,.01)
+20 SET FDA=$NAME(FDA(SFN,$SELECT(IEN:IEN,1:"+1")_","_DLG_","))
+21 IF QO
DO ADDQO
IF 'QO
DO ADDDG
+22 DO UPDATE^DIE("","FDA","IEN")
+23 SET X=$SELECT(IEN:IEN,1:+$GET(IEN(1)))
+24 IF 'ITM
SET ITM=X
+25 DO BMES^XPDUTL($SELECT(IEN:"Updated ",X:"Added ",1:"Unable to add ")_DX_" prompt "_$SELECT(IEN:"in ",1:"to ")_NAM_".")
End DoDot:1
+26 IF 'QO
IF ITM
DO ADDPMT(PMT,PKG,LBL,DX,ITM,0)
+27 QUIT
ADDDG SET @FDA@(.01)=SEQ
+1 SET @FDA@(2)=PMT
+2 ;required field
SET @FDA@(6)=REQ
+3 SET @FDA@(9)="*"
+4 SET @FDA@(17)="S Y="""""
+5 IF OTS>0
SET @FDA@(21)=OTS
+6 IF $LENGTH(FMT)
SET @FDA@(22)=FMT
+7 SET @FDA@(24)=LBL
+8 QUIT
ADDQO SET @FDA@(.01)=SEQ
+1 SET @FDA@(.02)=PMT
+2 SET @FDA@(.03)=1
+3 QUIT
+4 ; Change Mixed Name field value for Display Group
CHGMXNM(DSPGRP,MXNM) ;
+1 NEW FDA,IEN
+2 IF '$LENGTH($GET(DSPGRP))!('$LENGTH($GET(MXNM)))
QUIT
+3 SET IEN=$$FIND1^DIC(100.98,,"XQ",DSPGRP)
+4 IF 'IEN
QUIT
+5 SET FDA(100.98,IEN_",",2)=MXNM
+6 DO FILE^DIE("","FDA")
+7 QUIT
+8 ; Remove ORPF GRACE DAYS BEFORE PURGE parameter from
+9 ; ORP ORDER MISC parameter template
REMPRG NEW PAR,TPL,LP,FDA
+1 SET PAR=$$FIND1^DIC(8989.51,,"XQ","ORPF GRACE DAYS BEFORE PURGE")
+2 SET TPL=$$FIND1^DIC(8989.52,,"XQ","ORP ORDER MISC")
+3 IF 'PAR!'TPL
QUIT
+4 FOR LP=0:0
SET LP=$ORDER(^XTV(8989.52,TPL,10,LP))
IF 'LP
QUIT
IF $PIECE($GET(^(LP,0)),U,2)=PAR
Begin DoDot:1
+5 SET FDA(8989.521,LP_","_TPL_",",.01)="@"
End DoDot:1
+6 IF $DATA(FDA)
DO FILE^DIE("","FDA")
+7 QUIT
+8 ;
+9 ; File entry
STORE(FDA) ;EP
+1 NEW MSG
+2 DO UPDATE^DIE(,"FDA",,"MSG")
+3 IF $DATA(MSG)
Begin DoDot:1
+4 WRITE !,"The following error occurred:"
+5 WRITE !,$GET(MSG("DIERR",1,"TEXT",1))
+6 SET XPDQUIT=1
End DoDot:1
+7 KILL FDA
+8 QUIT
+9 ;
TRAN(VAL) ;EP - Check for entry inclusion
+1 IF "^OR GTX HM LIST SOURCE^OR GTX HM LAST DOSE TAKEN^OR GTX HM LOCATION OF MEDICATION^OR GTX HM REASON^"[X
QUIT 1
+2 QUIT 0
+3 ;
ADDRDIV ;
+1 ; Already exists
IF $$FIND1^DIC(100.22,,,"REQUESTING DIVISION")
QUIT
+2 NEW FDA,FN,IEN
+3 ; Check next ien value. Set to 1 if not between 1 and 999
SET IEN=$PIECE(^ORD(100.22,0),U,3)
+4 ; Move range of new entries to start with 1(or the next valid ien)
IF IEN>999
SET $PIECE(^ORD(100.22,0),U,3)=0
+5 SET FN=100.22
SET IEN="+1,"
+6 SET FDA(FN,IEN,.01)="REQUESTING DIVISION"
+7 SET FDA(FN,IEN,.02)="DIV:"
+8 SET FDA(FN,IEN,.03)="TEST LOCATION"
+9 SET FDA(FN,IEN,.04)="ORPRDIV"
+10 SET FDA(FN,IEN,1)="S ORPRDIV="""" I $P($G(^OR(100,+$G(ORIFN),0)),U,10) S ORPRDIV=$P(^SC(+$P(^(0),U,10),0),U,15) I ORPRDIV'="""" S ORPRDIV=$P($G(^DG(40.8,ORPRDIV,0)),U,1)"
+11 DO STORE(.FDA)
+12 QUIT
+13 ;
