ORIN1013 ;IHS/CIA/PLS - KIDS Inits for OR patch 1013 ;21-Nov-2013 15:07;PLS
;;3.0;ORDER ENTRY/RESULTS REPORTING;**1013**;Dec 17, 1997
;=================================================================
EC ;EP - Environment check
Q
PRE ;EP - Preinit
Q
;
POST ;EP - Postinit
Q
;
CHGPSO ;EP-
N DNM
S PKG="CONSULT/REQUEST TRACKING"
D ADDPMT("OR GTX PROB IEN","CONSULT/REQUEST TRACKING","Problem IEN:","Problem IEN",7.2,-1)
D ADDPMT("OR GTX SNOMED CONCEPT ID","CONSULT/REQUEST TRACKING","SNOMED Concept ID:","Concept ID",7.3,-1)
D ADDPMT("OR GTX CLININD","CONSULT/REQUEST TRACKING","Indication:","Clinical indicator",7.4,99,"%40")
D ADDPMT("OR GTX CLININD2","CONSULT/REQUEST TRACKING","Indication ICD9:","Clinical indicator ICD9",7.5,-1)
D ADDPMT("OR GTX SNOMED CONCEPT ID","LAB SERVICE","SNOMED Concept ID:","Concept ID",10.6,-1)
D ADDPMT("OR GTX SNOMED CONCEPT ID","OUTPATIENT PHARMACY","SNOMED Concept ID:","Concept ID",10.6,-1)
D ADDPMT("OR GTX SNOMED CONCEPT ID","PHARMACY DATA MANAGEMENT","SNOMED Concept ID:","Concept ID",10.6,-1)
D ADDPMT("OR GTX DSCMED","OUTPATIENT PHARMACY","Discharge Med:","Discharge Med",10.7,-1,,,"")
D ADDPMT("OR GTX DSCMED","PHARMACY DATA MANAGEMENT","Discharge Med:","Discharge Med",10.7,-1,,,"")
S DNM="GMRCOR CONSULT" D CHKGMRC(DNM)
F DNM="PSO OERR","LR OTHER LAB TESTS","GMRCOR CONSULT" D
.D CHKPSO1(DNM),CHKPSO5(DNM),CHKPSO6(DNM)
S DNM="PSO OERR" D CHKPSO7(DNM)
Q
CHKGMRC(DNM) ;EP
N DLG,PMT,IEN,FDA
S DLG=$$FIND1^DIC(101.41,,"XQ",DNM)
S PMT=$$FIND1^DIC(101.41,,"XQ","OR GTX PROB IEN")
Q:'PMT!'DLG
S IEN=$O(^ORD(101.41,DLG,10,"D",PMT,0))
Q:'IEN
S FDA(101.412,IEN_","_DLG_",",13)="I 0 ;stuffed in via Prov Dx"
S FDA(101.412,IEN_","_DLG_",",17)="S Y="""""
D FILE^DIE("","FDA")
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 SNOMED CONCEPT ID")
Q:'PMT!'DLG
S IEN=$O(^ORD(101.41,DLG,10,"D",PMT,0))
Q:'IEN
S FDA(101.412,IEN_","_DLG_",",8)=1
S FDA(101.412,IEN_","_DLG_",",9)="@"
S FDA(101.412,IEN_","_DLG_",",13)="I 0 ;stuffed in via Prov Dx"
S FDA(101.412,IEN_","_DLG_",",17)="S Y="""""
D FILE^DIE("","FDA")
Q
CHKPSO2(DNM) ;EP-
N DLG,PMT,IEN,FDA
S DLG=$$FIND1^DIC(101.41,,"XQ",DNM)
S PMT=$$FIND1^DIC(101.41,,"XQ","OR GTX PATIENT INSTRUCTIONS")
Q:'PMT!'DLG
S IEN=$O(^ORD(101.41,DLG,10,"D",PMT,0))
Q:'IEN
S FDA(101.412,IEN_","_DLG_",",13)="@"
S FDA(101.412,IEN_","_DLG_",",9)="@"
S FDA(101.412,IEN_","_DLG_",",19)="D PI^ORCDPS2"
S FDA(101.412,IEN_","_DLG_",",20)="D PIOUT^ORCDPS2"
D FILE^DIE("","FDA")
Q
CHKPSO3(DNM) ;EP
N DLG,PMT,IEN,FDA
S DLG=$$FIND1^DIC(101.41,,"XQ",DNM)
S PMT=$$FIND1^DIC(101.41,,"XQ","OR GTX WORD PROCESSING 1")
Q:'PMT!'DLG
S IEN=$O(^ORD(101.41,DLG,10,"D",PMT,0))
Q:'IEN
S FDA(101.412,IEN_","_DLG_",",4)="Notes to Pharmacist:"
D FILE^DIE("","FDA")
Q
CHKPSO4(DNM) ;EP
N DLG
S DLG=$$FIND1^DIC(101.41,,"XQ",DNM)
Q:'DLG
D CHKPSO4A(DLG,"OR GTX DAYS SUPPLY",8.5,"Days:")
D CHKPSO4A(DLG,"OR GTX CMF",,"*Chronic Med:")
D CHKPSO4A(DLG,"OR GTX WORD PROCESSING 1",99.5,"Notes to Pharmacist:",1)
Q
CHKPSO4A(DLG,PMTN,SEQ,LTXT,NEWLN) ;EP-
N FDA,IEN,PMT
S PMT=$$FIND1^DIC(101.41,,"XQ",PMTN)
Q:'PMT
S IEN=$O(^ORD(101.41,DLG,10,"D",PMT,0))
Q:'IEN
S:$G(SEQ)'="" FDA(101.412,IEN_","_DLG_",",21)=SEQ
S:$G(LTXT)'="" FDA(101.412,IEN_","_DLG_",",24)=LTXT
S:$G(NEWLN)'="" FDA(101.412,IEN_","_DLG_",",26)=NEWLN
D FILE^DIE("","FDA")
K FDA
Q
CHKPSO5(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_",",12)="GETDIAG;BEHOORSY"
S FDA(101.412,IEN_","_DLG_",",15)="D POST^BEHOORSY(+Y)"
S FDA(101.412,IEN_","_DLG_",",20)="D CHKDEL^BEHOORSY(+Y)"
D FILE^DIE("","FDA")
Q
CHKPSO6(DNM) ;EP-
N DLG,PMT,IEN,FDA
S DLG=$$FIND1^DIC(101.41,,"XQ",DNM)
S PMT=$$FIND1^DIC(101.41,,"XQ","OR GTX CLININD2")
Q:'PMT!'DLG
S IEN=$O(^ORD(101.41,DLG,10,"D",PMT,0))
Q:'IEN
S FDA(101.412,IEN_","_DLG_",",8)=2
D FILE^DIE("","FDA")
Q
CHKPSO7(DNM) ;EP-
N DLG,PMT,IEN,FDA
S DLG=$$FIND1^DIC(101.41,,"XQ",DNM)
S PMT=$$FIND1^DIC(101.41,,"XQ","OR GTX DSCMED")
Q:'PMT!'DLG
S IEN=$O(^ORD(101.41,DLG,10,"D",PMT,0))
Q:'IEN
S FDA(101.412,IEN_","_DLG_",",8)=2
D FILE^DIE("","FDA")
Q
; Change name of existing Order Dialog entry
CHGODNM(ODLGNM,NDLGNM) ;EP-
N FDA,IEN,DLG
S DLG=$$FIND1^DIC(101.41,,"XQ",ODLGNM)
Q:'DLG
S FDA(101.41,DLG_",",.01)=NDLGNM
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,AONA) ;
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)=$G(AONA,"*")
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^"[VAL 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
;
ORIN1013 ;IHS/CIA/PLS - KIDS Inits for OR patch 1013 ;21-Nov-2013 15:07;PLS
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**1013**;Dec 17, 1997
+2 ;=================================================================
EC ;EP - Environment check
+1 QUIT
PRE ;EP - Preinit
+1 QUIT
+2 ;
POST ;EP - Postinit
+1 QUIT
+2 ;
CHGPSO ;EP-
+1 NEW DNM
+2 SET PKG="CONSULT/REQUEST TRACKING"
+3 DO ADDPMT("OR GTX PROB IEN","CONSULT/REQUEST TRACKING","Problem IEN:","Problem IEN",7.2,-1)
+4 DO ADDPMT("OR GTX SNOMED CONCEPT ID","CONSULT/REQUEST TRACKING","SNOMED Concept ID:","Concept ID",7.3,-1)
+5 DO ADDPMT("OR GTX CLININD","CONSULT/REQUEST TRACKING","Indication:","Clinical indicator",7.4,99,"%40")
+6 DO ADDPMT("OR GTX CLININD2","CONSULT/REQUEST TRACKING","Indication ICD9:","Clinical indicator ICD9",7.5,-1)
+7 DO ADDPMT("OR GTX SNOMED CONCEPT ID","LAB SERVICE","SNOMED Concept ID:","Concept ID",10.6,-1)
+8 DO ADDPMT("OR GTX SNOMED CONCEPT ID","OUTPATIENT PHARMACY","SNOMED Concept ID:","Concept ID",10.6,-1)
+9 DO ADDPMT("OR GTX SNOMED CONCEPT ID","PHARMACY DATA MANAGEMENT","SNOMED Concept ID:","Concept ID",10.6,-1)
+10 DO ADDPMT("OR GTX DSCMED","OUTPATIENT PHARMACY","Discharge Med:","Discharge Med",10.7,-1,,,"")
+11 DO ADDPMT("OR GTX DSCMED","PHARMACY DATA MANAGEMENT","Discharge Med:","Discharge Med",10.7,-1,,,"")
+12 SET DNM="GMRCOR CONSULT"
DO CHKGMRC(DNM)
+13 FOR DNM="PSO OERR","LR OTHER LAB TESTS","GMRCOR CONSULT"
Begin DoDot:1
+14 DO CHKPSO1(DNM)
DO CHKPSO5(DNM)
DO CHKPSO6(DNM)
End DoDot:1
+15 SET DNM="PSO OERR"
DO CHKPSO7(DNM)
+16 QUIT
CHKGMRC(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 PROB IEN")
+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_",",13)="I 0 ;stuffed in via Prov Dx"
+8 SET FDA(101.412,IEN_","_DLG_",",17)="S Y="""""
+9 DO FILE^DIE("","FDA")
+10 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 SNOMED CONCEPT ID")
+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_",",8)=1
+8 SET FDA(101.412,IEN_","_DLG_",",9)="@"
+9 SET FDA(101.412,IEN_","_DLG_",",13)="I 0 ;stuffed in via Prov Dx"
+10 SET FDA(101.412,IEN_","_DLG_",",17)="S Y="""""
+11 DO FILE^DIE("","FDA")
+12 QUIT
CHKPSO2(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 PATIENT INSTRUCTIONS")
+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_",",13)="@"
+8 SET FDA(101.412,IEN_","_DLG_",",9)="@"
+9 SET FDA(101.412,IEN_","_DLG_",",19)="D PI^ORCDPS2"
+10 SET FDA(101.412,IEN_","_DLG_",",20)="D PIOUT^ORCDPS2"
+11 DO FILE^DIE("","FDA")
+12 QUIT
CHKPSO3(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 WORD PROCESSING 1")
+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_",",4)="Notes to Pharmacist:"
+8 DO FILE^DIE("","FDA")
+9 QUIT
CHKPSO4(DNM) ;EP
+1 NEW DLG
+2 SET DLG=$$FIND1^DIC(101.41,,"XQ",DNM)
+3 IF 'DLG
QUIT
+4 DO CHKPSO4A(DLG,"OR GTX DAYS SUPPLY",8.5,"Days:")
+5 DO CHKPSO4A(DLG,"OR GTX CMF",,"*Chronic Med:")
+6 DO CHKPSO4A(DLG,"OR GTX WORD PROCESSING 1",99.5,"Notes to Pharmacist:",1)
+7 QUIT
CHKPSO4A(DLG,PMTN,SEQ,LTXT,NEWLN) ;EP-
+1 NEW FDA,IEN,PMT
+2 SET PMT=$$FIND1^DIC(101.41,,"XQ",PMTN)
+3 IF 'PMT
QUIT
+4 SET IEN=$ORDER(^ORD(101.41,DLG,10,"D",PMT,0))
+5 IF 'IEN
QUIT
+6 IF $GET(SEQ)'=""
SET FDA(101.412,IEN_","_DLG_",",21)=SEQ
+7 IF $GET(LTXT)'=""
SET FDA(101.412,IEN_","_DLG_",",24)=LTXT
+8 IF $GET(NEWLN)'=""
SET FDA(101.412,IEN_","_DLG_",",26)=NEWLN
+9 DO FILE^DIE("","FDA")
+10 KILL FDA
+11 QUIT
CHKPSO5(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_",",12)="GETDIAG;BEHOORSY"
+8 SET FDA(101.412,IEN_","_DLG_",",15)="D POST^BEHOORSY(+Y)"
+9 SET FDA(101.412,IEN_","_DLG_",",20)="D CHKDEL^BEHOORSY(+Y)"
+10 DO FILE^DIE("","FDA")
+11 QUIT
CHKPSO6(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 CLININD2")
+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_",",8)=2
+8 DO FILE^DIE("","FDA")
+9 QUIT
CHKPSO7(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 DSCMED")
+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_",",8)=2
+8 DO FILE^DIE("","FDA")
+9 QUIT
+10 ; Change name of existing Order Dialog entry
CHGODNM(ODLGNM,NDLGNM) ;EP-
+1 NEW FDA,IEN,DLG
+2 SET DLG=$$FIND1^DIC(101.41,,"XQ",ODLGNM)
+3 IF 'DLG
QUIT
+4 SET FDA(101.41,DLG_",",.01)=NDLGNM
+5 DO FILE^DIE("","FDA")
+6 QUIT
+7 ; 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,AONA) ;
+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)=$GET(AONA,"*")
+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^"[VAL
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 ;
