FHIPSTG.m

FHIPSTG ; HISC/NCA - Adverse Reaction Interface ;1/11/96  10:06

 ;;5.0;Dietetics;**3**;Apr 21, 1996

 I +$$VERSION^XPDUTL("GMRA")'=4 W !,?10,"You do not have version 4 of Adverse Reaction Tracking.",!,?10,"The Protocols will not be installed." Q

 Q:'$D(^ORD(101,0))

 ; Clean up protocols

 S DA(1)=$O(^ORD(101,"B","GMRA SIGN-OFF ON DATA",0))

 S (DA,FHX)=$O(^ORD(101,"B","FH SIGNED REACTION INTERFACE",0))

 I DA S DA=$O(^ORD(101,DA(1),10,"B",DA,0)) I DA S DIK="^ORD(101,DA(1),10," D ^DIK

 I FHX S DA=FHX,DIK="^ORD(101," D ^DIK

 S DA(1)=$O(^ORD(101,"B","GMRA ENTERED IN ERROR",0))

 S (DA,FHX)=$O(^ORD(101,"B","FH SIGNED REACTION CANCEL",0))

 I DA S DA=$O(^ORD(101,DA(1),10,"B",DA,0)) I DA S DIK="^ORD(101,DA(1),10," D ^DIK

 I FHX S DA=FHX,DIK="^ORD(101," D ^DIK K DA,DIK

 W !!,"Add Dietetic protocols..."

 S NAM="FH SIGNED REACTION INTERFACE",TXT="FH Signed Reaction Interface"

 S PKG=$O(^DIC(9.4,"C","FH",0)),ACT="D EN1^FHWGMR"

 W !?2,"Filing protocol ",NAM

 K DIC S DIC="^ORD(101,",DIC(0)="L",DLAYGO=101,DIC("DR")="1///^S X=TXT;4///A;12////^S X=PKG;20////^S X=ACT",X=NAM D ^DIC K DA,DIC,DLAYGO,X

 S NAM="FH SIGNED REACTION CANCEL",TXT="FH Signed Reaction Cancel"

 S PKG=$O(^DIC(9.4,"C","FH",0)),ACT="D CAN^FHWGMR"

 W !?2,"Filing protocol ",NAM

 K DIC S DIC="^ORD(101,",DIC(0)="L",DLAYGO=101,DIC("DR")="1///^S X=TXT;4///A;12////^S X=PKG;20////^S X=ACT",X=NAM D ^DIC K DA,DIC,DLAYGO,X

 W !!,"Add Dietetic protocols to Adverse Reaction Tracking..."

 S X=" ;;GMRA SIGN-OFF ON DATA;FH SIGNED REACTION INTERFACE" D AD1

 S X=" ;;GMRA ENTERED IN ERROR;FH SIGNED REACTION CANCEL" D AD1

KIL K ACT,DA,DIC,DIE,DIK,DLAYGO,DR,FHX,LL,NAM,PKG,TXT,X,Y

 Q

AD1 ; Add Dietetic protocol to Adverse Reaction Tracking

 S DA(1)=$O(^ORD(101,"B",$P(X,";",3),0)) I 'DA(1) K DA Q

 K DIC S:'$D(^ORD(101,DA(1),10,0)) ^(0)="^101.01PA^^"

 S DIC="^ORD(101,"_DA(1)_",10,",DIC(0)="L",DLAYGO=101,X=$P(X,";",4) D ^DIC

 I $P(Y,"^",3) W !?2,X," added as item to ",$P(^ORD(101,DA(1),0),"^",1),"."

 K DA,DIC

 Q

FHIPSTG   ; HISC/NCA - Adverse Reaction Interface ;1/11/96  10:06

 +1       ;;5.0;Dietetics;**3**;Apr 21, 1996

 +2        IF +$$VERSION^XPDUTL("GMRA")'=4

               WRITE !,?10,"You do not have version 4 of Adverse Reaction Tracking.",!,?10,"The Protocols will not be installed."

               QUIT 

 +3        IF '$DATA(^ORD(101,0))

               QUIT 

 +4       ; Clean up protocols

 +5        SET DA(1)=$ORDER(^ORD(101,"B","GMRA SIGN-OFF ON DATA",0))

 +6        SET (DA,FHX)=$ORDER(^ORD(101,"B","FH SIGNED REACTION INTERFACE",0))

 +7        IF DA

               SET DA=$ORDER(^ORD(101,DA(1),10,"B",DA,0))

               IF DA

                   SET DIK="^ORD(101,DA(1),10,"

                   DO ^DIK

 +8        IF FHX

               SET DA=FHX

               SET DIK="^ORD(101,"

               DO ^DIK

 +9        SET DA(1)=$ORDER(^ORD(101,"B","GMRA ENTERED IN ERROR",0))

 +10       SET (DA,FHX)=$ORDER(^ORD(101,"B","FH SIGNED REACTION CANCEL",0))

 +11       IF DA

               SET DA=$ORDER(^ORD(101,DA(1),10,"B",DA,0))

               IF DA

                   SET DIK="^ORD(101,DA(1),10,"

                   DO ^DIK

 +12       IF FHX

               SET DA=FHX

               SET DIK="^ORD(101,"

               DO ^DIK

               KILL DA,DIK

 +13       WRITE !!,"Add Dietetic protocols..."

 +14       SET NAM="FH SIGNED REACTION INTERFACE"

           SET TXT="FH Signed Reaction Interface"

 +15       SET PKG=$ORDER(^DIC(9.4,"C","FH",0))

           SET ACT="D EN1^FHWGMR"

 +16       WRITE !?2,"Filing protocol ",NAM

 +17       KILL DIC

           SET DIC="^ORD(101,"

           SET DIC(0)="L"

           SET DLAYGO=101

           SET DIC("DR")="1///^S X=TXT;4///A;12////^S X=PKG;20////^S X=ACT"

           SET X=NAM

           DO ^DIC

           KILL DA,DIC,DLAYGO,X

 +18       SET NAM="FH SIGNED REACTION CANCEL"

           SET TXT="FH Signed Reaction Cancel"

 +19       SET PKG=$ORDER(^DIC(9.4,"C","FH",0))

           SET ACT="D CAN^FHWGMR"

 +20       WRITE !?2,"Filing protocol ",NAM

 +21       KILL DIC

           SET DIC="^ORD(101,"

           SET DIC(0)="L"

           SET DLAYGO=101

           SET DIC("DR")="1///^S X=TXT;4///A;12////^S X=PKG;20////^S X=ACT"

           SET X=NAM

           DO ^DIC

           KILL DA,DIC,DLAYGO,X

 +22       WRITE !!,"Add Dietetic protocols to Adverse Reaction Tracking..."

 +23       SET X=" ;;GMRA SIGN-OFF ON DATA;FH SIGNED REACTION INTERFACE"

           DO AD1

 +24       SET X=" ;;GMRA ENTERED IN ERROR;FH SIGNED REACTION CANCEL"

           DO AD1

KIL        KILL ACT,DA,DIC,DIE,DIK,DLAYGO,DR,FHX,LL,NAM,PKG,TXT,X,Y

 +1        QUIT 

AD1       ; Add Dietetic protocol to Adverse Reaction Tracking

 +1        SET DA(1)=$ORDER(^ORD(101,"B",$PIECE(X,";",3),0))

           IF 'DA(1)

               KILL DA

               QUIT 

 +2        KILL DIC

           IF '$DATA(^ORD(101,DA(1),10,0))

               SET ^(0)="^101.01PA^^"

 +3        SET DIC="^ORD(101,"_DA(1)_",10,"

           SET DIC(0)="L"

           SET DLAYGO=101

           SET X=$PIECE(X,";",4)

           DO ^DIC

 +4        IF $PIECE(Y,"^",3)

               WRITE !?2,X," added as item to ",$PIECE(^ORD(101,DA(1),0),"^",1),"."

 +5        KILL DA,DIC

 +6        QUIT