ORIN1005 ;IHS/CIA/DKM - KIDS Inits for OR patch 1005 ;16-Apr-2010 14:25;PLS
;;3.0;ORDER ENTRY/RESULTS REPORTING;**1005**;Dec 17, 1997
;=================================================================
EC ;EP - Environment check
Q
PRE ;EP - Preinit
D ADDL4SSN
D ADDPDEAN
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 REMPRG
D ADDCHILD("BEHOEN VISIT SUMMARY1")
D ADDCHILD("BEHOEN VISIT SUMMARY2")
D ADDCHILD("BEHOEN VISIT SUMMARIES")
D CHGMXNM("OUTPATIENT MEDICATIONS","Outpt. Meds")
I $$REGRPC^CIAURPC("ORWDXC MANUAL","CIAV VUECENTRIC")
I $$REGRPC^CIAURPC("ORWDXC RENEW","CIAV VUECENTRIC")
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
;
ADDL4SSN ;EP
Q:$$FIND1^DIC(100.22,,,"L4 SSN of Patient") ; 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)="L4 SSN of Patient"
S FDA(FN,IEN,.02)="L4S:"
S FDA(FN,IEN,.03)=2293
S FDA(FN,IEN,.04)="L4SSN"
S FDA(FN,IEN,1)="S L4SSN=$S($D(^DPT(+$G(ORVP),0)):$E($P(^(0),U,9),6,9),1:"""")"
D STORE(.FDA)
Q
ADDPDEAN ;
Q:$$FIND1^DIC(100.22,,,"PROVIDER DEA#") ; 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)="PROVIDER DEA#"
S FDA(FN,IEN,.02)="DEA#"
S FDA(FN,IEN,.03)="TESTDEA123"
S FDA(FN,IEN,.04)="ORDEAN"
S FDA(FN,IEN,1)="S ORDEAN=$$GET1^DIQ(200,+$$GET1^DIQ(100,+ORIFN,1,""I""),53.2)"
D STORE(.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
ORIN1005 ;IHS/CIA/DKM - KIDS Inits for OR patch 1005 ;16-Apr-2010 14:25;PLS
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**1005**;Dec 17, 1997
+2 ;=================================================================
EC ;EP - Environment check
+1 QUIT
PRE ;EP - Preinit
+1 DO ADDL4SSN
+2 DO ADDPDEAN
+3 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,"@")
End DoDot:1
+11 DO REMPRG
+12 DO ADDCHILD("BEHOEN VISIT SUMMARY1")
+13 DO ADDCHILD("BEHOEN VISIT SUMMARY2")
+14 DO ADDCHILD("BEHOEN VISIT SUMMARIES")
+15 DO CHGMXNM("OUTPATIENT MEDICATIONS","Outpt. Meds")
+16 IF $$REGRPC^CIAURPC("ORWDXC MANUAL","CIAV VUECENTRIC")
+17 IF $$REGRPC^CIAURPC("ORWDXC RENEW","CIAV VUECENTRIC")
+18 QUIT
+19 ; 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 ;
ADDL4SSN ;EP
+1 ; Already exists
IF $$FIND1^DIC(100.22,,,"L4 SSN of Patient")
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)="L4 SSN of Patient"
+7 SET FDA(FN,IEN,.02)="L4S:"
+8 SET FDA(FN,IEN,.03)=2293
+9 SET FDA(FN,IEN,.04)="L4SSN"
+10 SET FDA(FN,IEN,1)="S L4SSN=$S($D(^DPT(+$G(ORVP),0)):$E($P(^(0),U,9),6,9),1:"""")"
+11 DO STORE(.FDA)
+12 QUIT
ADDPDEAN ;
+1 ; Already exists
IF $$FIND1^DIC(100.22,,,"PROVIDER DEA#")
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)="PROVIDER DEA#"
+7 SET FDA(FN,IEN,.02)="DEA#"
+8 SET FDA(FN,IEN,.03)="TESTDEA123"
+9 SET FDA(FN,IEN,.04)="ORDEAN"
+10 SET FDA(FN,IEN,1)="S ORDEAN=$$GET1^DIQ(200,+$$GET1^DIQ(100,+ORIFN,1,""I""),53.2)"
+11 DO STORE(.FDA)
+12 QUIT
+13 ;
+14 ; 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
