DENTOP ; HISC/NCA - Post-Init to Add Options ;6/17/96 15:36
;;1.2;DENTAL;**21**;AUG 15, 1996
; Add Dental Options to Menu
W !!,"Add Dental Options to Dental Menu..."
S X=" ;;DENT PROGMAN;DENTPURGE;12" D AD2
S X=" ;;DENTACTMANAGER;DENTBATCH;10" D AD2
S X=" ;;DENTACTUSER;DENTBATCH;9" D AD2
KIL K ACT,DA,DENTX,DENTX1,DENTXA,DIC,DIE,DIK,DLAYGO,DR,LL,NAM,PKG,TXT,TYP,X,Y
Q
AD2 ; Add Dental Options to Dental Menus
S DA(1)=$O(^DIC(19,"B",$P(X,";",3),0)) I 'DA(1) K DA Q
K DIC S:'$D(^DIC(19,DA(1),10,0)) ^(0)="^19.01IP^^"
S DENTX=$O(^DIC(19,"B",$P(X,";",4),0)) I 'DENTX Q
S DENTXA=$O(^DIC(19,DA(1),10,"B",DENTX,0)) I DENTXA Q
S DENTX1=$P(X,";",5)
S DIC("DR")="2///"_DENTX1
S DIC="^DIC(19,"_DA(1)_",10,",DIC(0)="L",DLAYGO=19,X=$P(X,";",4) D ^DIC
I $P(Y,"^",3) W !?2,X," added as item to ",$P(^DIC(19,DA(1),0),"^",1),"."
K DA,DIC
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDENTOP 862 printed Dec 13, 2024@01:46:39 Page 2
DENTOP ; HISC/NCA - Post-Init to Add Options ;6/17/96 15:36
+1 ;;1.2;DENTAL;**21**;AUG 15, 1996
+2 ; Add Dental Options to Menu
+3 WRITE !!,"Add Dental Options to Dental Menu..."
+4 SET X=" ;;DENT PROGMAN;DENTPURGE;12"
DO AD2
+5 SET X=" ;;DENTACTMANAGER;DENTBATCH;10"
DO AD2
+6 SET X=" ;;DENTACTUSER;DENTBATCH;9"
DO AD2
KIL KILL ACT,DA,DENTX,DENTX1,DENTXA,DIC,DIE,DIK,DLAYGO,DR,LL,NAM,PKG,TXT,TYP,X,Y
+1 QUIT
AD2 ; Add Dental Options to Dental Menus
+1 SET DA(1)=$ORDER(^DIC(19,"B",$PIECE(X,";",3),0))
IF 'DA(1)
KILL DA
QUIT
+2 KILL DIC
if '$DATA(^DIC(19,DA(1),10,0))
SET ^(0)="^19.01IP^^"
+3 SET DENTX=$ORDER(^DIC(19,"B",$PIECE(X,";",4),0))
IF 'DENTX
QUIT
+4 SET DENTXA=$ORDER(^DIC(19,DA(1),10,"B",DENTX,0))
IF DENTXA
QUIT
+5 SET DENTX1=$PIECE(X,";",5)
+6 SET DIC("DR")="2///"_DENTX1
+7 SET DIC="^DIC(19,"_DA(1)_",10,"
SET DIC(0)="L"
SET DLAYGO=19
SET X=$PIECE(X,";",4)
DO ^DIC
+8 IF $PIECE(Y,"^",3)
WRITE !?2,X," added as item to ",$PIECE(^DIC(19,DA(1),0),"^",1),"."
+9 KILL DA,DIC
+10 QUIT
