- ORIN1010 ;IHS/CIA/PLS - KIDS Inits for OR patch 1010 ;07-Mar-2013 13:41;PLS
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**1010**;Dec 17, 1997;Build 47
- ;=================================================================
- EC ;EP - Environment check
- Q
- PRE ;EP - Preinit
- ;D CHGPSO
- Q
- POST ;EP - Postinit
- N PKG
- F PKG="LAB SERVICE","OUTPATIENT PHARMACY","PHARMACY DATA MANAGEMENT" D
- .D ADDPMT("OR GTX CLININD",PKG,"Indication:","clinical indicator",10,99,"%40")
- .D ADDPMT("OR GTX CLININD2",PKG,"Indication ICD9:","clinical indicator ICD9",10.5,-1)
- .Q:PKG="LAB SERVICE"
- .D ADDPMT("OR GTX CMF",PKG,"Chronic Med:","chronic med",4.7,10)
- .D ADDPMT("OR GTX DAW",PKG,"Dispense as Written:","dispense as written",4.8,10.1)
- .D ADDPMT("OR GTX PHARMACY",PKG,"Pharmacy:","pharmacy",7.1,99)
- .D ADDPMT("OR GTX SSREFREQ",PKG,"REFREQ Msg:","REFREQ Msg",7.2,99.1,"@",0)
- .D ADDPMT("OR GTX SSRREQIEN",PKG,"REFREQ IEN:","REFREQ IEN",7.3,99.2,"@")
- .D ADDPMT("OR GTX SSDENYRSN",PKG,"Reason to Deny:","Reason to Deny",7.4,99.3,"@")
- D REMPRG
- D ADDCHILD("BEHOEN VISIT SUMMARY1")
- D ADDCHILD("BEHOEN VISIT SUMMARY2")
- D ADDCHILD("BEHOEN VISIT SUMMARIES")
- D CHGMXNM("OUTPATIENT MEDICATIONS","Outpt. Meds")
- D CHGERX
- D CHGODDM("OR GTX DAYS SUPPLY","1:365")
- D CHGODDM("OR GTX QUANTITY",".01:99999999.99:3")
- D HERB
- D CHGPSO
- 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
- ; Attach prompts to Herbal dialog
- HERB ;EP-
- F PKG="HERBAL/OTC/NON-VA MEDS" D
- .D ADDPMT("OR GTX HM LAST DOSE TAKEN",PKG,"Last Dose Taken:","last dose taken",12.1,12.1,"5Z")
- .D ADDPMT("OR GTX HM LOCATION OF MEDICATION",PKG,"Medication Location:","medication location",12.2,12.2)
- .D ADDPMT("OR GTX HM LIST SOURCE",PKG,"Home Medication Source:","home medication source",12.3,12.3)
- .D ADDPMT("OR GTX HM REASON",PKG,"Reason for Medication:","reason for medication",12.4,12.4)
- 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 SSREFREQ^"[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
- ;
- ; Change ERX ORDER instance value for ORB URGENCY
- CHGERX ; EP-
- N ERR
- D DEL^XPAR("PKG","ORB URGENCY","ERX ORDER",.ERR)
- D ADD^XPAR("PKG","ORB URGENCY","ERX ORDER",1,.ERR)
- Q
- ORIN1010 ;IHS/CIA/PLS - KIDS Inits for OR patch 1010 ;07-Mar-2013 13:41;PLS
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**1010**;Dec 17, 1997;Build 47
- +2 ;=================================================================
- EC ;EP - Environment check
- +1 QUIT
- PRE ;EP - Preinit
- +1 ;D CHGPSO
- +2 QUIT
- POST ;EP - Postinit
- +1 NEW PKG
- +2 FOR PKG="LAB SERVICE","OUTPATIENT PHARMACY","PHARMACY DATA MANAGEMENT"
- Begin DoDot:1
- +3 DO ADDPMT("OR GTX CLININD",PKG,"Indication:","clinical indicator",10,99,"%40")
- +4 DO ADDPMT("OR GTX CLININD2",PKG,"Indication ICD9:","clinical indicator ICD9",10.5,-1)
- +5 IF PKG="LAB SERVICE"
- QUIT
- +6 DO ADDPMT("OR GTX CMF",PKG,"Chronic Med:","chronic med",4.7,10)
- +7 DO ADDPMT("OR GTX DAW",PKG,"Dispense as Written:","dispense as written",4.8,10.1)
- +8 DO ADDPMT("OR GTX PHARMACY",PKG,"Pharmacy:","pharmacy",7.1,99)
- +9 DO ADDPMT("OR GTX SSREFREQ",PKG,"REFREQ Msg:","REFREQ Msg",7.2,99.1,"@",0)
- +10 DO ADDPMT("OR GTX SSRREQIEN",PKG,"REFREQ IEN:","REFREQ IEN",7.3,99.2,"@")
- +11 DO ADDPMT("OR GTX SSDENYRSN",PKG,"Reason to Deny:","Reason to Deny",7.4,99.3,"@")
- End DoDot:1
- +12 DO REMPRG
- +13 DO ADDCHILD("BEHOEN VISIT SUMMARY1")
- +14 DO ADDCHILD("BEHOEN VISIT SUMMARY2")
- +15 DO ADDCHILD("BEHOEN VISIT SUMMARIES")
- +16 DO CHGMXNM("OUTPATIENT MEDICATIONS","Outpt. Meds")
- +17 DO CHGERX
- +18 DO CHGODDM("OR GTX DAYS SUPPLY","1:365")
- +19 DO CHGODDM("OR GTX QUANTITY",".01:99999999.99:3")
- +20 DO HERB
- +21 DO CHGPSO
- +22 QUIT
- +23 ;
- 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 ; Attach prompts to Herbal dialog
- HERB ;EP-
- +1 FOR PKG="HERBAL/OTC/NON-VA MEDS"
- Begin DoDot:1
- +2 DO ADDPMT("OR GTX HM LAST DOSE TAKEN",PKG,"Last Dose Taken:","last dose taken",12.1,12.1,"5Z")
- +3 DO ADDPMT("OR GTX HM LOCATION OF MEDICATION",PKG,"Medication Location:","medication location",12.2,12.2)
- +4 DO ADDPMT("OR GTX HM LIST SOURCE",PKG,"Home Medication Source:","home medication source",12.3,12.3)
- +5 DO ADDPMT("OR GTX HM REASON",PKG,"Reason for Medication:","reason for medication",12.4,12.4)
- End DoDot:1
- +6 QUIT
- +7 ; 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 SSREFREQ^"[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 ;
- +14 ; Change ERX ORDER instance value for ORB URGENCY
- CHGERX ; EP-
- +1 NEW ERR
- +2 DO DEL^XPAR("PKG","ORB URGENCY","ERX ORDER",.ERR)
- +3 DO ADD^XPAR("PKG","ORB URGENCY","ERX ORDER",1,.ERR)
- +4 QUIT