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 Dec 13, 2024@01:59:29 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(%)