DGJ1INIP ;ALB/MRY - Post-install of DGJ v1.0 ;[ 11/21/01 13:20 pm]
;;1.0;Incomplete Records Tracking;;Jun 25, 2001
;
; Update PACKAGE (#2) File fields not updated by the KIDS install.
; Used for documentation purposes.
;
D BMES^XPDUTL(" ")
D MES^XPDUTL(" Updating PACKAGE File...")
;
PKG ; Retrieve 'DGJ' Package name
; Get Package IEN
D FIND^DIC(9.4,"","@;1","P","DGJ","","C","","","DGJARRY")
S (DGJI,DGJIEN)=0
F S DGJI=$O(DGJARRY("DILIST",DGJI)) Q:'DGJI D
. Q:$P($G(DGJARRY("DILIST",DGJI,0)),"^",2)'="DGJ"
. S DGJIEN=$P($G(DGJARRY("DILIST",DGJI,0)),"^",1)
I 'DGJIEN D G ABRT^DGJ1INIT
. D BMES^XPDUTL(" ")
. D MES^XPDUTL(" No Package entry defined - Cannot update!")
;
UPD ; - Update fields not updated by the KIDS install.
; fields:
; Short Description (#2); required field
; Description (#3) ; word processing field
; File (#6) ; multiple
; Fields ; multiple
;
; - Replace Short Description (#2) field.
K FDATA S FDATA(9.4,DGJIEN_",",2)="IRT"
D FILE^DIE("E","FDATA","ERR")
D BMES^XPDUTL(" ")
D MES^XPDUTL(" SHORT DESCRIPTION field complete.")
K FDATA,ERR
;
; - Replace Description (#3) field. Leave blank.
D WP^DIE(9.4,DGJIEN_",",3,"K","")
D BMES^XPDUTL(" ")
D MES^XPDUTL(" DESCRIPTION field complete.")
;
FILE ; - Replace File (#9.44) field.
; first remove (delete) existing fields.
N DIC K DGJARRY
D LIST^DIC(9.44,","_DGJIEN_",","@;.01","P","","","","","","","DGJARRY")
S DGJII=0
F S DGJII=$O(DGJARRY("DILIST",DGJII)) Q:'DGJII D
. S DGJFIEN=$P(DGJARRY("DILIST",DGJII,0),"^",1)
. S DIE="^DIC(9.4,",DA(1)=DGJIEN,DIE=DIE_DA(1)_",4,"
. S DA=+DGJFIEN,DR=".01///@" D ^DIE
; after old entries deleted, add current File entries
F X="40.8","43","405","393","393.1","393.2","393.3","393.41" D
. S DIC="^DIC(9.4,",DA(1)=DGJIEN
. S DIC=DIC_DA(1)_",4,",DIC(0)="L",DIC("P")=$P(^DD(9.4,6,0),"^",2)
. D ^DIC
D BMES^XPDUTL(" ")
D MES^XPDUTL(" FILE field complete.")
; - Add fields.
FLDS ; Add FIELD entries to File entries #40.8, #43, #405.
; Add ASSIGN A VERSION NUMBER? entries to File entries #393-393.41.
S DIC="^DIC(9.4,",DA(1)=DGJIEN,DIC(0)="X"
S DIC=DIC_DA(1)_",4,",DIC("P")=$P(^DD(9.4,6,0),"^",2)
F X="40.8","43","405","393","393.1","393.2","393.3","393.41" D
. D ^DIC
. S DIE=DIC,DA=+Y
. I X="40.8" F FLD="100.01","100.02","100.03","100.04","100.05","100.06","100.07","100.08","100.09","100.1","100.2","100.3" S DR="2///"_FLD D ^DIE
. I X="43" F FLD="401","513" S DR="2///"_FLD D ^DIE
. I X=405 S FLD=60.01 S DR="2///"_FLD D ^DIE
. I X[393 S DR="222.2///Y" D ^DIE
D BMES^XPDUTL(" ")
D MES^XPDUTL(" FIELD field complete.")
;
XPREF ; Add 'DGJZ' entry to the EXCLUDED NAME SPACE (#919) field of DGJ.
S DIC="^DIC(9.4,",DA(1)=DGJIEN
S DIC=DIC_DA(1)_",""EX"",",DIC(0)="L",DIC("P")=$P(^DD(9.4,919,0),"^",2)
S X="DGJZ" D ^DIC
;
; Add 'DGJ' entry to the EXCLUDED NAME SPACE (#919) field of DG.
S DIC="^DIC(9.4,",DIC(0)="X",X="REGISTRATION"
D ^DIC I Y<0 D G ABRT^DGJ1INIT
. D BMES^XPDUTL("REGISTRATION PACKAGE HAS NOT BEEN FOUND")
. D MES^XPDUTL("CONTACT - PIMS National VISTA Support Team for assistance!")
S DA(1)=+Y,DIC=DIC_DA(1)_",""EX"",",DIC(0)="L",DIC("P")=$P(^DD(9.4,919,0),"^",2)
S X="DGJ" D ^DIC
;
EXIT K DIC,DIE,DGJII,DGJFIEN,DGJIEN,X,DA,DGJARRY
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGJ1INIP 3396 printed Apr 09, 2024@21:02:19 Page 2
DGJ1INIP ;ALB/MRY - Post-install of DGJ v1.0 ;[ 11/21/01 13:20 pm]
+1 ;;1.0;Incomplete Records Tracking;;Jun 25, 2001
+2 ;
+3 ; Update PACKAGE (#2) File fields not updated by the KIDS install.
+4 ; Used for documentation purposes.
+5 ;
+6 DO BMES^XPDUTL(" ")
+7 DO MES^XPDUTL(" Updating PACKAGE File...")
+8 ;
PKG ; Retrieve 'DGJ' Package name
+1 ; Get Package IEN
+2 DO FIND^DIC(9.4,"","@;1","P","DGJ","","C","","","DGJARRY")
+3 SET (DGJI,DGJIEN)=0
+4 FOR
SET DGJI=$ORDER(DGJARRY("DILIST",DGJI))
if 'DGJI
QUIT
Begin DoDot:1
+5 if $PIECE($GET(DGJARRY("DILIST",DGJI,0)),"^",2)'="DGJ"
QUIT
+6 SET DGJIEN=$PIECE($GET(DGJARRY("DILIST",DGJI,0)),"^",1)
End DoDot:1
+7 IF 'DGJIEN
Begin DoDot:1
+8 DO BMES^XPDUTL(" ")
+9 DO MES^XPDUTL(" No Package entry defined - Cannot update!")
End DoDot:1
GOTO ABRT^DGJ1INIT
+10 ;
UPD ; - Update fields not updated by the KIDS install.
+1 ; fields:
+2 ; Short Description (#2); required field
+3 ; Description (#3) ; word processing field
+4 ; File (#6) ; multiple
+5 ; Fields ; multiple
+6 ;
+7 ; - Replace Short Description (#2) field.
+8 KILL FDATA
SET FDATA(9.4,DGJIEN_",",2)="IRT"
+9 DO FILE^DIE("E","FDATA","ERR")
+10 DO BMES^XPDUTL(" ")
+11 DO MES^XPDUTL(" SHORT DESCRIPTION field complete.")
+12 KILL FDATA,ERR
+13 ;
+14 ; - Replace Description (#3) field. Leave blank.
+15 DO WP^DIE(9.4,DGJIEN_",",3,"K","")
+16 DO BMES^XPDUTL(" ")
+17 DO MES^XPDUTL(" DESCRIPTION field complete.")
+18 ;
FILE ; - Replace File (#9.44) field.
+1 ; first remove (delete) existing fields.
+2 NEW DIC
KILL DGJARRY
+3 DO LIST^DIC(9.44,","_DGJIEN_",","@;.01","P","","","","","","","DGJARRY")
+4 SET DGJII=0
+5 FOR
SET DGJII=$ORDER(DGJARRY("DILIST",DGJII))
if 'DGJII
QUIT
Begin DoDot:1
+6 SET DGJFIEN=$PIECE(DGJARRY("DILIST",DGJII,0),"^",1)
+7 SET DIE="^DIC(9.4,"
SET DA(1)=DGJIEN
SET DIE=DIE_DA(1)_",4,"
+8 SET DA=+DGJFIEN
SET DR=".01///@"
DO ^DIE
End DoDot:1
+9 ; after old entries deleted, add current File entries
+10 FOR X="40.8","43","405","393","393.1","393.2","393.3","393.41"
Begin DoDot:1
+11 SET DIC="^DIC(9.4,"
SET DA(1)=DGJIEN
+12 SET DIC=DIC_DA(1)_",4,"
SET DIC(0)="L"
SET DIC("P")=$PIECE(^DD(9.4,6,0),"^",2)
+13 DO ^DIC
End DoDot:1
+14 DO BMES^XPDUTL(" ")
+15 DO MES^XPDUTL(" FILE field complete.")
+16 ; - Add fields.
FLDS ; Add FIELD entries to File entries #40.8, #43, #405.
+1 ; Add ASSIGN A VERSION NUMBER? entries to File entries #393-393.41.
+2 SET DIC="^DIC(9.4,"
SET DA(1)=DGJIEN
SET DIC(0)="X"
+3 SET DIC=DIC_DA(1)_",4,"
SET DIC("P")=$PIECE(^DD(9.4,6,0),"^",2)
+4 FOR X="40.8","43","405","393","393.1","393.2","393.3","393.41"
Begin DoDot:1
+5 DO ^DIC
+6 SET DIE=DIC
SET DA=+Y
+7 IF X="40.8"
FOR FLD="100.01","100.02","100.03","100.04","100.05","100.06","100.07","100.08","100.09","100.1","100.2","100.3"
SET DR="2///"_FLD
DO ^DIE
+8 IF X="43"
FOR FLD="401","513"
SET DR="2///"_FLD
DO ^DIE
+9 IF X=405
SET FLD=60.01
SET DR="2///"_FLD
DO ^DIE
+10 IF X[393
SET DR="222.2///Y"
DO ^DIE
End DoDot:1
+11 DO BMES^XPDUTL(" ")
+12 DO MES^XPDUTL(" FIELD field complete.")
+13 ;
XPREF ; Add 'DGJZ' entry to the EXCLUDED NAME SPACE (#919) field of DGJ.
+1 SET DIC="^DIC(9.4,"
SET DA(1)=DGJIEN
+2 SET DIC=DIC_DA(1)_",""EX"","
SET DIC(0)="L"
SET DIC("P")=$PIECE(^DD(9.4,919,0),"^",2)
+3 SET X="DGJZ"
DO ^DIC
+4 ;
+5 ; Add 'DGJ' entry to the EXCLUDED NAME SPACE (#919) field of DG.
+6 SET DIC="^DIC(9.4,"
SET DIC(0)="X"
SET X="REGISTRATION"
+7 DO ^DIC
IF Y<0
Begin DoDot:1
+8 DO BMES^XPDUTL("REGISTRATION PACKAGE HAS NOT BEEN FOUND")
+9 DO MES^XPDUTL("CONTACT - PIMS National VISTA Support Team for assistance!")
End DoDot:1
GOTO ABRT^DGJ1INIT
+10 SET DA(1)=+Y
SET DIC=DIC_DA(1)_",""EX"","
SET DIC(0)="L"
SET DIC("P")=$PIECE(^DD(9.4,919,0),"^",2)
+11 SET X="DGJ"
DO ^DIC
+12 ;
EXIT KILL DIC,DIE,DGJII,DGJFIEN,DGJIEN,X,DA,DGJARRY
+1 QUIT
