SDYDPOST.m

SDYDPOST ;MJK/ALB - API Post Init;01 APR 1993

 ;;5.3;Scheduling;**27,1015**;08/13/93;Build 21

 ;

EN ;

 D STUFF ; set notification parameters

 D VISIT ; add SD in visit parameters

 D FIXPRO ; enable new CPT protocols

 Q

 ;

STUFF ; -- stuff parameters if both not set

 S X=$G(^DG(43,1,"SCLR"))

 IF $P(X,U,26)="",$P(X,U,27)="" D

 . D BMES^XPDUTL(">>> Setting API Notification Parameters...")

 . S DIE=43,DR="226////"_$P(X,U,17)_";227////E",DA=1 D ^DIE

 Q

 ;

VISIT ; -- add SD in visit parameters

 S X="VSITAPI" X ^%ZOSF("TEST")

 IF $T,$$PKGON^VSIT("SD")=-1 D

 . N SDVAR

 . D BMES^XPDUTL(">>> Adding Scheduling to Visit Parameters files...")

 . S SDVAR=$$PKG^VSIT("SD",0)

 . IF SDVAR>0 D

 . . D BMES^XPDUTL("     ...successfully added with value of 'ACTIVE FLAG' set to '"_$S($P(SDVAR,U,2):"ON",1:"OFF")_"'.")

 . ELSE  D

 . . D MES^XPDUTL("     ...NOTE: Unable to add Scheduling.")

 Q

 ;

NOTE ; -- manually set notification parameters

 D BMES^XPDUTL(">>> Set API Notification Parameters...")

 S DIE=43,DR="226;227",DA=1 D ^DIE

 Q

 ;

FIXPRO ;Enable CPT protocols

 ;

 ;Input  : None

 ;Output : None

 ;Notes  : This is a KIDS complient check point

 ;

 ;Declare variables

 N DIC,DIE,DA,DR,X,Y,DTOUT,DUOUT,MSGTXT,PTRPROT,SDYDX

 D BMES^XPDUTL(">>> Enabling New CPT Protocols")

 ;Find protocol

 F SDYDX="SDCO CPT","SDAM CPT" D

 .S PTRPROT=+$O(^ORD(101,"B",SDYDX,""))

 .I ('PTRPROT) D  Q

 ..S MSGTXT(1)="    ** Unable to find SDCO CPT in PROTOCOL file (#101)"

 ..S MSGTXT(2)="    ** Entry must be manually created"

 ..D MES^XPDUTL(.MSGTXT)

 .;Enable protocol

 .S DIE="^ORD(101,"

 .S DA=PTRPROT

 .S DR="2///@"

 .D ^DIE

 ;Done

 Q

 ;

SDYDPOST  ;MJK/ALB - API Post Init;01 APR 1993

 +1       ;;5.3;Scheduling;**27,1015**;08/13/93;Build 21

 +2       ;

EN        ;

 +1       ; set notification parameters

           DO STUFF

 +2       ; add SD in visit parameters

           DO VISIT

 +3       ; enable new CPT protocols

           DO FIXPRO

 +4        QUIT 

 +5       ;

STUFF     ; -- stuff parameters if both not set

 +1        SET X=$GET(^DG(43,1,"SCLR"))

 +2        IF $PIECE(X,U,26)=""

               IF $PIECE(X,U,27)=""

                   Begin DoDot:1

 +3                    DO BMES^XPDUTL(">>> Setting API Notification Parameters...")

 +4                    SET DIE=43

                       SET DR="226////"_$PIECE(X,U,17)_";227////E"

                       SET DA=1

                       DO ^DIE

                   End DoDot:1

 +5        QUIT 

 +6       ;

VISIT     ; -- add SD in visit parameters

 +1        SET X="VSITAPI"

           XECUTE ^%ZOSF("TEST")

 +2        IF $TEST

               IF $$PKGON^VSIT("SD")=-1

                   Begin DoDot:1

 +3                    NEW SDVAR

 +4                    DO BMES^XPDUTL(">>> Adding Scheduling to Visit Parameters files...")

 +5                    SET SDVAR=$$PKG^VSIT("SD",0)

 +6                    IF SDVAR>0

                           Begin DoDot:2

 +7                            DO BMES^XPDUTL("     ...successfully added with value of 'ACTIVE FLAG' set to '"_$SELECT($PIECE(SDVAR,U,2):"ON",1:"OFF")_"'.")

                           End DoDot:2

 +8                   IF '$TEST

                           Begin DoDot:2

 +9                            DO MES^XPDUTL("     ...NOTE: Unable to add Scheduling.")

                           End DoDot:2

                   End DoDot:1

 +10       QUIT 

 +11      ;

NOTE      ; -- manually set notification parameters

 +1        DO BMES^XPDUTL(">>> Set API Notification Parameters...")

 +2        SET DIE=43

           SET DR="226;227"

           SET DA=1

           DO ^DIE

 +3        QUIT 

 +4       ;

FIXPRO    ;Enable CPT protocols

 +1       ;

 +2       ;Input  : None

 +3       ;Output : None

 +4       ;Notes  : This is a KIDS complient check point

 +5       ;

 +6       ;Declare variables

 +7        NEW DIC,DIE,DA,DR,X,Y,DTOUT,DUOUT,MSGTXT,PTRPROT,SDYDX

 +8        DO BMES^XPDUTL(">>> Enabling New CPT Protocols")

 +9       ;Find protocol

 +10       FOR SDYDX="SDCO CPT","SDAM CPT"

               Begin DoDot:1

 +11               SET PTRPROT=+$ORDER(^ORD(101,"B",SDYDX,""))

 +12               IF ('PTRPROT)

                       Begin DoDot:2

 +13                       SET MSGTXT(1)="    ** Unable to find SDCO CPT in PROTOCOL file (#101)"

 +14                       SET MSGTXT(2)="    ** Entry must be manually created"

 +15                       DO MES^XPDUTL(.MSGTXT)

                       End DoDot:2

                       QUIT 

 +16      ;Enable protocol

 +17               SET DIE="^ORD(101,"

 +18               SET DA=PTRPROT

 +19               SET DR="2///@"

 +20               DO ^DIE

               End DoDot:1

 +21      ;Done

 +22       QUIT 

 +23      ;