DENTOP.m

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 ---DENTOP   862     printed  Apr 09, 2024@20:51:22                                                                                                                                                                                                       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