source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGYVPOST.m@ 1259

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

initial load of WorldVistAEHR

File size: 4.3 KB
Line 
1DGYVPOST ;ALB/LD - Patch DG*5.3*64 Post-Init ; 8/8/95
2 ;;5.3;Registration;**64**;Aug 13, 1993
3 ;
4 ;
5 ;-- Populate FACILITY TREATING SPECIALTY file (#45.7) with effective
6 ;-- date and active flag from pointed to Effective Date multiple
7 ;-- entries in the TREATING SPECIALTY file (#42.4).
8 ;
9EN ;-- Entry point
10 ;
11 N DGPTQ
12 D XREFCHK
13 I $G(DGPTQ) D DONE
14 I '$G(DGPTQ) D RXREF,POPMUL,ERRPT,INACT^DGYVPST1,DONE
15ENQ Q
16 ;
17XREFCHK ;-- Check for "ASPEC" xref in ^DD(45.7
18 ;
19 W !!,">>> This post-init will populate the Effective Date multiple of each record",!?4,"in the Facility Treating Specialty file (#45.7).",!!
20 N I S (DGPTQ,I)=0,I=$O(^DD(45.7,0,"IX","ASPEC",45.7,I))
21 I '$G(I) S DGPTQ=1
22 I $G(I) I '$D(^DD(45.7,"IX",I)) S DGPTQ=1
23 I $G(DGPTQ) W !,"***ERROR: Cross reference ""ASPEC"" in file #45.7 not found.",!?10,"Rerun init DGYVINIT from patch DG*5.3*64 (see patch description",!?10,"for complete instructions).",!
24 Q
25 ;
26RXREF ;--Reindex Specialty (#1) field "ASPEC" xref in file 45.7
27 ;
28 N DIK
29 S DIK="^DIC(45.7,",DIK(1)="1" D ENALL^DIK
30 Q
31 ;
32POPMUL ;--Get data from file 42.4 to populate eff date mult in file 45.7
33 ;
34 W !!,">>> Post-Init started at: " D NOW^%DTC W $$FTIME^VALM1(%),!
35 ;
36 N DGPTERR,DGPTMIEN,DGPTOUT,DGPTSIEN,DIRUT,DTOUT,DUOUT
37 F DGPTMIEN=0:0 S DGPTMIEN=$O(^DIC(45.7,"ASPEC",DGPTMIEN)) Q:'DGPTMIEN!($G(DGPTOUT)) D
38 .F DGPTSIEN=0:0 S DGPTSIEN=$O(^DIC(45.7,"ASPEC",DGPTMIEN,DGPTSIEN)) Q:'DGPTSIEN!($G(DGPTOUT)) D
39 ..N DGPTASK,DGPTEFF,DGPTCTR,DGPTI
40 ..;--Subentry doesn't exist in file 42.4
41 ..I '$D(^DIC(42.4,DGPTMIEN,"E",0)) S ^TMP("DGPTERR",$J,DGPTMIEN,DGPTSIEN,1)="" Q
42 ..;--Get total # of subentries from file 42.4 subfile header node
43 ..S DGPTCTR=$P($G(^DIC(42.4,DGPTMIEN,"E",0)),U,4) I DGPTCTR'>0 S ^TMP("DGPTERR",$J,DGPTMIEN,DGPTSIEN,2)="" Q
44 ..F DGPTI=1:1:DGPTCTR Q:$G(DGPTOUT)!($G(DGPTEFF)=0) D POPFAC
45POPMULQ Q
46 ;
47POPFAC ;--Populate eff date mult in FTS file #45.7
48 N DGPTACTF,DGPTEFDT,DGPTNODE,DA,DIC,DIE,DINUM,DR,X,Y
49 ;--Get effective date and active flag from file 42.4 subentry
50 S DGPTNODE=$G(^DIC(42.4,DGPTMIEN,"E",DGPTI,0)) I DGPTNODE']"" S ^TMP("DGPTERR",$J,DGPTMIEN,DGPTSIEN,3)="" G POPFACQ
51 I (DGPTMIEN=70!(DGPTMIEN=71)!(DGPTMIEN=77)),('$G(DGPTASK)) D ASK
52 I $D(DIRUT)!$D(DUOUT)!$D(DTOUT) S ^TMP("DGPTERR",$J,DGPTMIEN,DGPTSIEN,4)="",DGPTOUT=1 G POPFACQ
53 I $G(DGPTEFF)=0 S DGPTCTR=1 ;if no to inactivate, add active eff date only
54 S DGPTEFDT=$P(DGPTNODE,U),DGPTACTF=$P(DGPTNODE,U,2)
55 ;--Add fields to file 45.7 subentry
56 S DIC="^DIC(45.7,"_DGPTSIEN_",""E"","
57 S DIC(0)="L"
58 S (DA,DINUM)=DGPTI
59 S X=DGPTEFDT
60 ;--Extra variables needed since it's a multiple
61 S DIC("P")=$P(^DD(45.7,100,0),"^",2)
62 S DA(1)=DGPTSIEN
63 ;--Create/edit subentry
64 S DIC("DR")=".02///^S X="_DGPTACTF
65 K DD,DO D FILE^DICN
66 I $G(Y)=-1 S ^TMP("DGPTERR",$J,DGPTMIEN,DGPTSIEN,5)=""
67 I $G(DTOUT)!($G(DUOUT)) S ^TMP("DGPTERR",$J,DGPTMIEN,DGPTSIEN,4)="",DGPTOUT=1 G POPFACQ
68 ;--Write msg (once) to screen while processing
69 I $G(Y)>0,($G(DGPTI)<2) W !!,"... Added ",$S('$G(DGPTEFF):"active ",1:"inactive "),"effective date and ",$S('$G(DGPTEFF):"active ",1:"inactive "),"flag to facility",!?4,"treating specialty ",$P($G(^DIC(45.7,DGPTSIEN,0)),U)
70 ;
71POPFACQ Q
72ASK ;
73 W !! S DIR("A")=" Inactivate facility treating specialty"
74 S DIR("A",1)=" Facility treating specialty, "_$P($G(^DIC(45.7,DGPTSIEN,0)),U)_","
75 S DIR("A",2)=" is pointing to an inactive treating specialty in the Specialty (#42.4)"
76 S DIR("A",3)=" file. Answering 'Yes' to this prompt will make the facility treating"
77 S DIR("A",4)=" specialty inactive also."
78 S DIR("A",5)=" "
79 S DIR(0)="Y",DIR("B")="NO" D ^DIR K DIR S (DGPTASK,DGPTEFF)=+Y K Y
80 W !
81ASKQ Q
82 ;
83ERRPT ;--Queue error report for printing or print direct
84 Q:'$D(^TMP("DGPTERR",$J))
85 ;
86 W !!,">>> The following report will list all messages and/or errors which occurred",!?4,"while running this post-init.",!
87 N POP,ZTDESC,ZTRTN,ZTSAVE,ZTSK
88 S %ZIS="QMP" D ^%ZIS K %ZIS I POP Q
89 I '$D(IO("Q")) U IO D PRTERR^DGYVPST1,^%ZISC G ERRPTQ
90 ; task job
91 S ZTRTN="PRTERR^DGYVPST1",ZTSAVE("^TMP(""DGPTERR"",$J,")=""
92 S ZTDESC="Patch DG*5.3*64 Post-Init Error Report"
93 D ^%ZTLOAD
94 W !!,$S($D(ZTSK):">>> Job has been queued. The task number is "_ZTSK_".",1:">>> Unable to queue this job.")
95ERRPTQ K IO("Q"),^TMP("DGPTERR",$J)
96 Q
97 ;
98DONE W !!,">>> Post-Init completed at: " D NOW^%DTC W $$FTIME^VALM1(%),!
99 Q
100 ;
Note: See TracBrowser for help on using the repository browser.