- ORIN1002 ;IHS/CIA/DKM - KIDS Inits for OR patch 1002 ;17-May-2007 15:20;DKM
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**1002**;Dec 17, 1997
- ;=================================================================
- EC ;EP - Environment check
- Q
- PRE ;EP - Preinit
- D RENPARAM^BEHUTIL("CIAOHSM HEALTH SUMMARY LIST","ORWRPBHS HEALTH SUMMARY LIST")
- Q
- POST ;EP - Postinit
- D ADDPMT("OR GTX CLININD","LAB SERVICE","Indication:","clinical indicator",10,99)
- D ADDPMT("OR GTX CLININD2","LAB SERVICE","Indication ICD9:","clinical indicator ICD9",10.5,-1)
- D ADDPMT("OR GTX CMF","OUTPATIENT PHARMACY","Chronic Med:","chronic med",4.7,10)
- D ADDPMT("OR GTX CMF","PHARMACY DATA MANAGEMENT","Chronic Med:","chronic med",4.7,10)
- D REMPRG
- Q
- ; Add prompt to selected order and quick order dialogs
- ADDPMT(PMT,PKG,LBL,DX,SEQ,OTS) ;
- N DLG,TYP,ITM,QO,X,Y
- 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
- 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)=1
- S @FDA@(9)="*"
- S @FDA@(17)="S Y="""""
- S:OTS>0 @FDA@(21)=OTS
- S @FDA@(24)=LBL
- Q
- ADDQO S @FDA@(.01)=SEQ
- S @FDA@(.02)=PMT
- S @FDA@(.03)=1
- 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
- ORIN1002 ;IHS/CIA/DKM - KIDS Inits for OR patch 1002 ;17-May-2007 15:20;DKM
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**1002**;Dec 17, 1997
- +2 ;=================================================================
- EC ;EP - Environment check
- +1 QUIT
- PRE ;EP - Preinit
- +1 DO RENPARAM^BEHUTIL("CIAOHSM HEALTH SUMMARY LIST","ORWRPBHS HEALTH SUMMARY LIST")
- +2 QUIT
- POST ;EP - Postinit
- +1 DO ADDPMT("OR GTX CLININD","LAB SERVICE","Indication:","clinical indicator",10,99)
- +2 DO ADDPMT("OR GTX CLININD2","LAB SERVICE","Indication ICD9:","clinical indicator ICD9",10.5,-1)
- +3 DO ADDPMT("OR GTX CMF","OUTPATIENT PHARMACY","Chronic Med:","chronic med",4.7,10)
- +4 DO ADDPMT("OR GTX CMF","PHARMACY DATA MANAGEMENT","Chronic Med:","chronic med",4.7,10)
- +5 DO REMPRG
- +6 QUIT
- +7 ; Add prompt to selected order and quick order dialogs
- ADDPMT(PMT,PKG,LBL,DX,SEQ,OTS) ;
- +1 NEW DLG,TYP,ITM,QO,X,Y
- +2 IF PMT'=+PMT
- SET PMT=$$FIND1^DIC(101.41,,"XQ",PMT)
- +3 IF PKG'=+PKG
- SET PKG=$$FIND1^DIC(9.4,,"XQ",PKG)
- +4 IF 'PMT!'PKG
- QUIT
- +5 SET QO='OTS
- SET TYP=$SELECT(QO:"Q",1:"D")
- SET ITM=0
- +6 FOR DLG=0:0
- SET DLG=$ORDER(^ORD(101.41,DLG))
- IF 'DLG
- QUIT
- SET X=$GET(^(DLG,0))
- Begin DoDot:1
- +7 NEW FDA,IEN,NAM,SUB,SFN
- +8 IF $PIECE(X,U,4)'=TYP
- QUIT
- +9 SET Y=$PIECE(X,U,7)
- +10 IF 'Y
- IF QO
- Begin DoDot:2
- +11 SET Y=$PIECE(X,U,5)
- +12 IF Y
- SET Y=$PIECE($GET(^ORD(100.98,Y,0)),U,4)
- +13 IF Y
- SET Y=$PIECE($GET(^ORD(101.41,Y,0)),U,7)
- End DoDot:2
- +14 IF Y'=PKG
- QUIT
- +15 SET SUB=$SELECT(QO:6,1:10)
- SET SFN=$SELECT(QO:101.416,1:101.412)
- +16 IF '$ORDER(^ORD(101.41,DLG,SUB,"D",0))
- QUIT
- +17 SET IEN=$ORDER(^ORD(101.41,DLG,SUB,"D",PMT,0))
- +18 SET NAM=$$GET1^DIQ(101.41,DLG,.01)
- +19 SET FDA=$NAME(FDA(SFN,$SELECT(IEN:IEN,1:"+1")_","_DLG_","))
- +20 IF QO
- DO ADDQO
- IF 'QO
- DO ADDDG
- +21 DO UPDATE^DIE("","FDA","IEN")
- +22 SET X=$SELECT(IEN:IEN,1:+$GET(IEN(1)))
- +23 IF 'ITM
- SET ITM=X
- +24 DO BMES^XPDUTL($SELECT(IEN:"Updated ",X:"Added ",1:"Unable to add ")_DX_" prompt "_$SELECT(IEN:"in ",1:"to ")_NAM_".")
- End DoDot:1
- +25 IF 'QO
- IF ITM
- DO ADDPMT(PMT,PKG,LBL,DX,ITM,0)
- +26 QUIT
- ADDDG SET @FDA@(.01)=SEQ
- +1 SET @FDA@(2)=PMT
- +2 SET @FDA@(6)=1
- +3 SET @FDA@(9)="*"
- +4 SET @FDA@(17)="S Y="""""
- +5 IF OTS>0
- SET @FDA@(21)=OTS
- +6 SET @FDA@(24)=LBL
- +7 QUIT
- ADDQO SET @FDA@(.01)=SEQ
- +1 SET @FDA@(.02)=PMT
- +2 SET @FDA@(.03)=1
- +3 QUIT
- +4 ; Remove ORPF GRACE DAYS BEFORE PURGE parameter from
- +5 ; 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
