ORIN1003.m

ORIN1003 ;IHS/CIA/DKM - KIDS Inits for OR patch 1003 ;05-Nov-2007 12:58;DKM

 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**1003**;Dec 17, 1997

 ;=================================================================

EC ;EP - Environment check

 Q

PRE ;EP - Preinit

 Q

POST ;EP - Postinit

 D ADDPMT("OR GTX CLININD","LAB SERVICE","Indication:","clinical indicator",10,99,"%40")

 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)

 Q

 ; Add prompt to selected order and quick order dialogs

ADDPMT(PMT,PKG,LBL,DX,SEQ,OTS,FMT) ;

 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,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)=1

 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

ORIN1003  ;IHS/CIA/DKM - KIDS Inits for OR patch 1003 ;05-Nov-2007 12:58;DKM

 +1       ;;3.0;ORDER ENTRY/RESULTS REPORTING;**1003**;Dec 17, 1997

 +2       ;=================================================================

EC        ;EP - Environment check

 +1        QUIT 

PRE       ;EP - Preinit

 +1        QUIT 

POST      ;EP - Postinit

 +1        DO ADDPMT("OR GTX CLININD","LAB SERVICE","Indication:","clinical indicator",10,99,"%40")

 +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        QUIT 

 +6       ; Add prompt to selected order and quick order dialogs

ADDPMT(PMT,PKG,LBL,DX,SEQ,OTS,FMT) ;

 +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

           SET FMT=$GET(FMT)

 +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        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