GMTSPREI ;SLC/SBW - GMTS* Preinit ;4/18/95
 ;;2.7;Health Summary;;Oct 20, 1995
MAIN ; Controls branching
 N GMI
 W !!,"First I need to run a pre-init...."
 W !,"Starting pre-init now...."
 S GMTSIST=$$NOW
 D APPGRP,RENMED
 D DELFLD ;Entry point to delete obsolete fields in file #142
 W !,"Pre-init successfully completed!"
 Q
APPGRP ; Add "GMTS" Application Group to file 60, 71, 120.51, 9999999.64,
 ; 9001017, and 811.9. Done only if not there already.
 N GMI
 F GMI=60,71,120.51,9999999.64,9001017,811.9 I '$D(^DIC(GMI,"%","B","GMTS")) K DD,DO S DIC="^DIC("_GMI_",""%"",",DIC(0)="L",DA(1)=GMI,X="GMTS" D FILE^DICN K DIC,DA W:+Y>0 !!,"Adding ""GMTS"" Application Group to ^DIC("_GMI_",",!
 Q
RENMED ; Rename medicine summary comp. abbreviation
 N GMDA,DA,DIE,DR
 Q:+$D(^GMT(142.1))'>0
 F X="MEDICINE SUMMARY" D
 . S DIC=142.1,DIC(0)="X" D ^DIC I +Y'>0  Q
 . S DIE=142.1,DR="3///MEDS",DA=+Y D ^DIE
 . W !!,"** Renaming Medicine Summary Abbreviation from MED to MEDS **"
 Q
DELFLD ; Deletes obsolete fields in Health Summary Type (#142) file
 N DIK,DA,GMX,DIU
 Q:+$D(^GMT(142))'>0
 F GMX=2,3,4,5,6 D
 . S DA=GMX,DIK="^DD(142,"
 . D ^DIK W !,"Deleting field # ",GMX," in the Health Summary Type (#142) file."
 F DIU=142.02,142.05,142.06 S DIU(0)="S" D EN^DIU2
 Q
NOW() ; Extrinsic special variable to return current date/time
 N %,%H,%I,X
 D NOW^%DTC
 Q +$G(%)
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSPREI   1397     printed  Sep 23, 2025@19:35:32                                                                                                                                                                                                    Page 2
GMTSPREI  ;SLC/SBW - GMTS* Preinit ;4/18/95
 +1       ;;2.7;Health Summary;;Oct 20, 1995
MAIN      ; Controls branching
 +1        NEW GMI
 +2        WRITE !!,"First I need to run a pre-init...."
 +3        WRITE !,"Starting pre-init now...."
 +4        SET GMTSIST=$$NOW
 +5        DO APPGRP
           DO RENMED
 +6       ;Entry point to delete obsolete fields in file #142
           DO DELFLD
 +7        WRITE !,"Pre-init successfully completed!"
 +8        QUIT 
APPGRP    ; Add "GMTS" Application Group to file 60, 71, 120.51, 9999999.64,
 +1       ; 9001017, and 811.9. Done only if not there already.
 +2        NEW GMI
 +3        FOR GMI=60,71,120.51,9999999.64,9001017,811.9
               IF '$DATA(^DIC(GMI,"%","B","GMTS"))
                   KILL DD,DO
                   SET DIC="^DIC("_GMI_",""%"","
                   SET DIC(0)="L"
                   SET DA(1)=GMI
                   SET X="GMTS"
                   DO FILE^DICN
                   KILL DIC,DA
                   if +Y>0
                       WRITE !!,"Adding ""GMTS"" Application Group to ^DIC("_GMI_",",!
 +4        QUIT 
RENMED    ; Rename medicine summary comp. abbreviation
 +1        NEW GMDA,DA,DIE,DR
 +2        if +$DATA(^GMT(142.1))'>0
               QUIT 
 +3        FOR X="MEDICINE SUMMARY"
               Begin DoDot:1
 +4                SET DIC=142.1
                   SET DIC(0)="X"
                   DO ^DIC
                   IF +Y'>0
                       QUIT 
 +5                SET DIE=142.1
                   SET DR="3///MEDS"
                   SET DA=+Y
                   DO ^DIE
 +6                WRITE !!,"** Renaming Medicine Summary Abbreviation from MED to MEDS **"
               End DoDot:1
 +7        QUIT 
DELFLD    ; Deletes obsolete fields in Health Summary Type (#142) file
 +1        NEW DIK,DA,GMX,DIU
 +2        if +$DATA(^GMT(142))'>0
               QUIT 
 +3        FOR GMX=2,3,4,5,6
               Begin DoDot:1
 +4                SET DA=GMX
                   SET DIK="^DD(142,"
 +5                DO ^DIK
                   WRITE !,"Deleting field # ",GMX," in the Health Summary Type (#142) file."
               End DoDot:1
 +6        FOR DIU=142.02,142.05,142.06
               SET DIU(0)="S"
               DO EN^DIU2
 +7        QUIT 
NOW()     ; Extrinsic special variable to return current date/time
 +1        NEW %,%H,%I,X
 +2        DO NOW^%DTC
 +3        QUIT +$GET(%)