| 1 | SDYDPOST ;MJK/ALB - API Post Init;01 APR 1993
 | 
|---|
| 2 |  ;;5.3;Scheduling;**27**;08/13/93
 | 
|---|
| 3 |  ;
 | 
|---|
| 4 | EN ;
 | 
|---|
| 5 |  D STUFF ; set notification parameters
 | 
|---|
| 6 |  D VISIT ; add SD in visit parameters
 | 
|---|
| 7 |  D FIXPRO ; enable new CPT protocols
 | 
|---|
| 8 |  Q
 | 
|---|
| 9 |  ;
 | 
|---|
| 10 | STUFF ; -- stuff parameters if both not set
 | 
|---|
| 11 |  S X=$G(^DG(43,1,"SCLR"))
 | 
|---|
| 12 |  IF $P(X,U,26)="",$P(X,U,27)="" D
 | 
|---|
| 13 |  . D BMES^XPDUTL(">>> Setting API Notification Parameters...")
 | 
|---|
| 14 |  . S DIE=43,DR="226////"_$P(X,U,17)_";227////E",DA=1 D ^DIE
 | 
|---|
| 15 |  Q
 | 
|---|
| 16 |  ;
 | 
|---|
| 17 | VISIT ; -- add SD in visit parameters
 | 
|---|
| 18 |  S X="VSITAPI" X ^%ZOSF("TEST")
 | 
|---|
| 19 |  IF $T,$$PKGON^VSIT("SD")=-1 D
 | 
|---|
| 20 |  . N SDVAR
 | 
|---|
| 21 |  . D BMES^XPDUTL(">>> Adding Scheduling to Visit Parameters files...")
 | 
|---|
| 22 |  . S SDVAR=$$PKG^VSIT("SD",0)
 | 
|---|
| 23 |  . IF SDVAR>0 D
 | 
|---|
| 24 |  . . D BMES^XPDUTL("     ...successfully added with value of 'ACTIVE FLAG' set to '"_$S($P(SDVAR,U,2):"ON",1:"OFF")_"'.")
 | 
|---|
| 25 |  . ELSE  D
 | 
|---|
| 26 |  . . D MES^XPDUTL("     ...NOTE: Unable to add Scheduling.")
 | 
|---|
| 27 |  Q
 | 
|---|
| 28 |  ;
 | 
|---|
| 29 | NOTE ; -- manually set notification parameters
 | 
|---|
| 30 |  D BMES^XPDUTL(">>> Set API Notification Parameters...")
 | 
|---|
| 31 |  S DIE=43,DR="226;227",DA=1 D ^DIE
 | 
|---|
| 32 |  Q
 | 
|---|
| 33 |  ;
 | 
|---|
| 34 | FIXPRO ;Enable CPT protocols
 | 
|---|
| 35 |  ;
 | 
|---|
| 36 |  ;Input  : None
 | 
|---|
| 37 |  ;Output : None
 | 
|---|
| 38 |  ;Notes  : This is a KIDS complient check point
 | 
|---|
| 39 |  ;
 | 
|---|
| 40 |  ;Declare variables
 | 
|---|
| 41 |  N DIC,DIE,DA,DR,X,Y,DTOUT,DUOUT,MSGTXT,PTRPROT,SDYDX
 | 
|---|
| 42 |  D BMES^XPDUTL(">>> Enabling New CPT Protocols")
 | 
|---|
| 43 |  ;Find protocol
 | 
|---|
| 44 |  F SDYDX="SDCO CPT","SDAM CPT" D
 | 
|---|
| 45 |  .S PTRPROT=+$O(^ORD(101,"B",SDYDX,""))
 | 
|---|
| 46 |  .I ('PTRPROT) D  Q
 | 
|---|
| 47 |  ..S MSGTXT(1)="    ** Unable to find SDCO CPT in PROTOCOL file (#101)"
 | 
|---|
| 48 |  ..S MSGTXT(2)="    ** Entry must be manually created"
 | 
|---|
| 49 |  ..D MES^XPDUTL(.MSGTXT)
 | 
|---|
| 50 |  .;Enable protocol
 | 
|---|
| 51 |  .S DIE="^ORD(101,"
 | 
|---|
| 52 |  .S DA=PTRPROT
 | 
|---|
| 53 |  .S DR="2///@"
 | 
|---|
| 54 |  .D ^DIE
 | 
|---|
| 55 |  ;Done
 | 
|---|
| 56 |  Q
 | 
|---|
| 57 |  ;
 | 
|---|