source: WorldVistAEHR/trunk/r/INCOMPLETE_RECORDS_TRACKING-DGJ/DGJ1INIP.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.2 KB
Line 
1DGJ1INIP ;ALB/MRY - Post-install of DGJ v1.0 ;[ 11/21/01 13:20 pm]
2 ;;1.0;Incomplete Records Tracking;;Jun 25, 2001
3 ;
4 ; Update PACKAGE (#2) File fields not updated by the KIDS install.
5 ; Used for documentation purposes.
6 ;
7 D BMES^XPDUTL(" ")
8 D MES^XPDUTL(" Updating PACKAGE File...")
9 ;
10PKG ; Retrieve 'DGJ' Package name
11 ; Get Package IEN
12 D FIND^DIC(9.4,"","@;1","P","DGJ","","C","","","DGJARRY")
13 S (DGJI,DGJIEN)=0
14 F S DGJI=$O(DGJARRY("DILIST",DGJI)) Q:'DGJI D
15 . Q:$P($G(DGJARRY("DILIST",DGJI,0)),"^",2)'="DGJ"
16 . S DGJIEN=$P($G(DGJARRY("DILIST",DGJI,0)),"^",1)
17 I 'DGJIEN D G ABRT^DGJ1INIT
18 . D BMES^XPDUTL(" ")
19 . D MES^XPDUTL(" No Package entry defined - Cannot update!")
20 ;
21UPD ; - Update fields not updated by the KIDS install.
22 ; fields:
23 ; Short Description (#2); required field
24 ; Description (#3) ; word processing field
25 ; File (#6) ; multiple
26 ; Fields ; multiple
27 ;
28 ; - Replace Short Description (#2) field.
29 K FDATA S FDATA(9.4,DGJIEN_",",2)="IRT"
30 D FILE^DIE("E","FDATA","ERR")
31 D BMES^XPDUTL(" ")
32 D MES^XPDUTL(" SHORT DESCRIPTION field complete.")
33 K FDATA,ERR
34 ;
35 ; - Replace Description (#3) field. Leave blank.
36 D WP^DIE(9.4,DGJIEN_",",3,"K","")
37 D BMES^XPDUTL(" ")
38 D MES^XPDUTL(" DESCRIPTION field complete.")
39 ;
40FILE ; - Replace File (#9.44) field.
41 ; first remove (delete) existing fields.
42 N DIC K DGJARRY
43 D LIST^DIC(9.44,","_DGJIEN_",","@;.01","P","","","","","","","DGJARRY")
44 S DGJII=0
45 F S DGJII=$O(DGJARRY("DILIST",DGJII)) Q:'DGJII D
46 . S DGJFIEN=$P(DGJARRY("DILIST",DGJII,0),"^",1)
47 . S DIE="^DIC(9.4,",DA(1)=DGJIEN,DIE=DIE_DA(1)_",4,"
48 . S DA=+DGJFIEN,DR=".01///@" D ^DIE
49 ; after old entries deleted, add current File entries
50 F X="40.8","43","405","393","393.1","393.2","393.3","393.41" D
51 . S DIC="^DIC(9.4,",DA(1)=DGJIEN
52 . S DIC=DIC_DA(1)_",4,",DIC(0)="L",DIC("P")=$P(^DD(9.4,6,0),"^",2)
53 . D ^DIC
54 D BMES^XPDUTL(" ")
55 D MES^XPDUTL(" FILE field complete.")
56 ; - Add fields.
57FLDS ; Add FIELD entries to File entries #40.8, #43, #405.
58 ; Add ASSIGN A VERSION NUMBER? entries to File entries #393-393.41.
59 S DIC="^DIC(9.4,",DA(1)=DGJIEN,DIC(0)="X"
60 S DIC=DIC_DA(1)_",4,",DIC("P")=$P(^DD(9.4,6,0),"^",2)
61 F X="40.8","43","405","393","393.1","393.2","393.3","393.41" D
62 . D ^DIC
63 . S DIE=DIC,DA=+Y
64 . 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
65 . I X="43" F FLD="401","513" S DR="2///"_FLD D ^DIE
66 . I X=405 S FLD=60.01 S DR="2///"_FLD D ^DIE
67 . I X[393 S DR="222.2///Y" D ^DIE
68 D BMES^XPDUTL(" ")
69 D MES^XPDUTL(" FIELD field complete.")
70 ;
71XPREF ; Add 'DGJZ' entry to the EXCLUDED NAME SPACE (#919) field of DGJ.
72 S DIC="^DIC(9.4,",DA(1)=DGJIEN
73 S DIC=DIC_DA(1)_",""EX"",",DIC(0)="L",DIC("P")=$P(^DD(9.4,919,0),"^",2)
74 S X="DGJZ" D ^DIC
75 ;
76 ; Add 'DGJ' entry to the EXCLUDED NAME SPACE (#919) field of DG.
77 S DIC="^DIC(9.4,",DIC(0)="X",X="REGISTRATION"
78 D ^DIC I Y<0 D G ABRT^DGJ1INIT
79 . D BMES^XPDUTL("REGISTRATION PACKAGE HAS NOT BEEN FOUND")
80 . D MES^XPDUTL("CONTACT - PIMS National VISTA Support Team for assistance!")
81 S DA(1)=+Y,DIC=DIC_DA(1)_",""EX"",",DIC(0)="L",DIC("P")=$P(^DD(9.4,919,0),"^",2)
82 S X="DGJ" D ^DIC
83 ;
84EXIT K DIC,DIE,DGJII,DGJFIEN,DGJIEN,X,DA,DGJARRY
85 Q
Note: See TracBrowser for help on using the repository browser.