| 1 | IBDY325 ;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 | ;
|
|---|
| 9 | SET ; -- 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 | ;
|
|---|
| 19 | Y2K ; -- 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 | ;
|
|---|
| 27 | UNCOMP ; -- 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 | ;
|
|---|
| 35 | RECOMP ; 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 | ;
|
|---|
| 62 | DEL ; -- 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
|
|---|
