SDYDPOST ;MJK/ALB - API Post Init;01 APR 1993
;;5.3;Scheduling;**27**;08/13/93
;
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
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDYDPOST 1662 printed Nov 22, 2024@18:13:34 Page 2
SDYDPOST ;MJK/ALB - API Post Init;01 APR 1993
+1 ;;5.3;Scheduling;**27**;08/13/93
+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 ;
