source: WorldVistAEHR/trunk/r/AUTOMATED_INFO_COLLECTION_SYS-IBD/IBDY325.m@ 724

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

initial load of WorldVistAEHR

File size: 2.4 KB
Line 
1IBDY325 ;ALB/AAS - POST INSTALL FOR PATCH IBD*3*25 ; 23-JUN-97
2 ;;3.0;AUTOMATED INFO COLLECTION SYS;**25**;APR 24, 1997
3 ;
4 D SET,Y2K,DEL
5 D UNCOMP,RECOMP
6 Q
7 ;
8 ;
9SET ; -- set default values in new encounter form parameters
10 N X
11 S X=$P($G(^IBD(357.09,1,0)),"^",12,14)
12 I X=""!(X="^^") D ;only update once
13 .D MES^XPDUTL(">>> Now setting the default value in new Encounter Form Parameters.")
14 .S $P(^IBD(357.09,1,0),"^",12)=5
15 .S $P(^IBD(357.09,1,0),"^",13)=12
16 .S $P(^IBD(357.09,1,0),"^",14)=25
17 Q
18 ;
19Y2K ; -- update the Checkout date/time AICS DATA ELEMENT entry for Y2K
20 N IEN
21 S IEN=$O(^IBE(359.1,"B","CHECKOUT DATE@TIME",0)) Q:'IEN
22 S $P(^IBE(359.1,IEN,0),"^",5)="______@____"
23 S $P(^IBE(359.1,IEN,10),"^",2)="NNNNNNPNNNN"
24 S $P(^IBE(359.1,IEN,10),"^",4)="NNNNNNPNNNN"
25 Q
26 ;
27UNCOMP ; -- uncompile all forms --
28 N ZTQUEUED
29 D MES^XPDUTL(">>> Now uncompiling all Encounter Forms.")
30 S ZTQUEUED=1
31 D RECMPALL^IBDF19
32 D MES^XPDUTL(" Okay, forms will be recompiled as they are printed.")
33 Q
34 ;
35RECOMP ; Recompile all forms in file 359.2
36 N C,X,COUNT,CNT,COLWIDTH,IBDFSA,IBFORMID,IBBDT,IBEDT,IBDAY,LBEGIN,LEND,NODE10,POP,PRIORPG,QUIT
37 ;
38 S IBBDT=$H
39 S COUNT=$P(^IBD(359.2,0),"^",4)
40 ;
41 D MES^XPDUTL(">>> I am going to recompile all "_COUNT_" entries in your FORM SPECS file (359.2)")
42 D MES^XPDUTL(">>> Recompilation Started at "_$$HTE^XLFDT(IBBDT))
43 D MES^XPDUTL(">>> This may take awhile... (about 5 seconds per entry on an unloaded system)")
44 ;
45 S CNT=0
46 S IBFORMID=0 F S IBFORMID=$O(^IBD(359.2,IBFORMID)) Q:'IBFORMID D
47 .D SCAN^IBDFBKS(IBFORMID)
48 .S CNT=CNT+1
49 .I '$D(ZTQUEUED),'(CNT#10) D MES^XPDUTL(" "_CNT_" done, "_(COUNT-CNT)_" to go.")
50 ;
51 S IBEDT=$H
52 D MES^XPDUTL("")
53 D MES^XPDUTL(">>> Recompilation Complete at "_$$HTE^XLFDT(IBEDT))
54 I $D(IBBDT) D
55 .S IBDAY=+IBEDT-(+IBBDT)*86400 ;additional seconds of over midnight
56 .S X=IBDAY+$P(IBEDT,",",2)-$P(IBBDT,",",2)
57 .D MES^XPDUTL(">>> Elapse time for recompilation was: "_(X\3600)_" Hours, "_(X\60-(X\3600*60))_" Minutes, "_(X#60)_" Seconds")
58 .S X=(X/COUNT)
59 .D MES^XPDUTL(">>> Average Time per Entry was: "_(X\60-(X\3600*60))_" Minutes, "_(X#60)_" Seconds")
60 Q
61 ;
62DEL ; -- delete unused field
63 N DIK,DA,CNT
64 S DIK="^DD(357.613,",DA(1)=357.613
65 I $D(^DD(357.613,.02)) D
66 . S DA=.02,CNT=$G(CNT)+1
67 . D ^DIK
68 I $D(^DD(357.613,.06)) D
69 . S CNT=$G(CNT)+1
70 . S DA=.06
71 . D ^DIK
72 ;
73 K DIK,DA
74 D:$G(CNT) MES^XPDUTL(">>> Deleted "_$G(CNT)_" unused field"_$S($G(CNT)=1:"",1:"s")_" in the Package Interface File")
75 Q
Note: See TracBrowser for help on using the repository browser.