IBDY325 ;ALB/AAS - POST INSTALL FOR PATCH IBD*3*25 ; 23-JUN-97
;;3.0;AUTOMATED INFO COLLECTION SYS;**25**;APR 24, 1997
;
D SET,Y2K,DEL
D UNCOMP,RECOMP
Q
;
;
SET ; -- set default values in new encounter form parameters
N X
S X=$P($G(^IBD(357.09,1,0)),"^",12,14)
I X=""!(X="^^") D ;only update once
.D MES^XPDUTL(">>> Now setting the default value in new Encounter Form Parameters.")
.S $P(^IBD(357.09,1,0),"^",12)=5
.S $P(^IBD(357.09,1,0),"^",13)=12
.S $P(^IBD(357.09,1,0),"^",14)=25
Q
;
Y2K ; -- update the Checkout date/time AICS DATA ELEMENT entry for Y2K
N IEN
S IEN=$O(^IBE(359.1,"B","CHECKOUT DATE@TIME",0)) Q:'IEN
S $P(^IBE(359.1,IEN,0),"^",5)="______@____"
S $P(^IBE(359.1,IEN,10),"^",2)="NNNNNNPNNNN"
S $P(^IBE(359.1,IEN,10),"^",4)="NNNNNNPNNNN"
Q
;
UNCOMP ; -- uncompile all forms --
N ZTQUEUED
D MES^XPDUTL(">>> Now uncompiling all Encounter Forms.")
S ZTQUEUED=1
D RECMPALL^IBDF19
D MES^XPDUTL(" Okay, forms will be recompiled as they are printed.")
Q
;
RECOMP ; Recompile all forms in file 359.2
N C,X,COUNT,CNT,COLWIDTH,IBDFSA,IBFORMID,IBBDT,IBEDT,IBDAY,LBEGIN,LEND,NODE10,POP,PRIORPG,QUIT
;
S IBBDT=$H
S COUNT=$P(^IBD(359.2,0),"^",4)
;
D MES^XPDUTL(">>> I am going to recompile all "_COUNT_" entries in your FORM SPECS file (359.2)")
D MES^XPDUTL(">>> Recompilation Started at "_$$HTE^XLFDT(IBBDT))
D MES^XPDUTL(">>> This may take awhile... (about 5 seconds per entry on an unloaded system)")
;
S CNT=0
S IBFORMID=0 F S IBFORMID=$O(^IBD(359.2,IBFORMID)) Q:'IBFORMID D
.D SCAN^IBDFBKS(IBFORMID)
.S CNT=CNT+1
.I '$D(ZTQUEUED),'(CNT#10) D MES^XPDUTL(" "_CNT_" done, "_(COUNT-CNT)_" to go.")
;
S IBEDT=$H
D MES^XPDUTL("")
D MES^XPDUTL(">>> Recompilation Complete at "_$$HTE^XLFDT(IBEDT))
I $D(IBBDT) D
.S IBDAY=+IBEDT-(+IBBDT)*86400 ;additional seconds of over midnight
.S X=IBDAY+$P(IBEDT,",",2)-$P(IBBDT,",",2)
.D MES^XPDUTL(">>> Elapse time for recompilation was: "_(X\3600)_" Hours, "_(X\60-(X\3600*60))_" Minutes, "_(X#60)_" Seconds")
.S X=(X/COUNT)
.D MES^XPDUTL(">>> Average Time per Entry was: "_(X\60-(X\3600*60))_" Minutes, "_(X#60)_" Seconds")
Q
;
DEL ; -- delete unused field
N DIK,DA,CNT
S DIK="^DD(357.613,",DA(1)=357.613
I $D(^DD(357.613,.02)) D
. S DA=.02,CNT=$G(CNT)+1
. D ^DIK
I $D(^DD(357.613,.06)) D
. S CNT=$G(CNT)+1
. S DA=.06
. D ^DIK
;
K DIK,DA
D:$G(CNT) MES^XPDUTL(">>> Deleted "_$G(CNT)_" unused field"_$S($G(CNT)=1:"",1:"s")_" in the Package Interface File")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBDY325 2554 printed Apr 09, 2024@21:25:29 Page 2
IBDY325 ;ALB/AAS - POST INSTALL FOR PATCH IBD*3*25 ; 23-JUN-97
+1 ;;3.0;AUTOMATED INFO COLLECTION SYS;**25**;APR 24, 1997
+2 ;
+3 DO SET
DO Y2K
DO DEL
+4 DO UNCOMP
DO RECOMP
+5 QUIT
+6 ;
+7 ;
SET ; -- set default values in new encounter form parameters
+1 NEW X
+2 SET X=$PIECE($GET(^IBD(357.09,1,0)),"^",12,14)
+3 ;only update once
IF X=""!(X="^^")
Begin DoDot:1
+4 DO MES^XPDUTL(">>> Now setting the default value in new Encounter Form Parameters.")
+5 SET $PIECE(^IBD(357.09,1,0),"^",12)=5
+6 SET $PIECE(^IBD(357.09,1,0),"^",13)=12
+7 SET $PIECE(^IBD(357.09,1,0),"^",14)=25
End DoDot:1
+8 QUIT
+9 ;
Y2K ; -- update the Checkout date/time AICS DATA ELEMENT entry for Y2K
+1 NEW IEN
+2 SET IEN=$ORDER(^IBE(359.1,"B","CHECKOUT DATE@TIME",0))
if 'IEN
QUIT
+3 SET $PIECE(^IBE(359.1,IEN,0),"^",5)="______@____"
+4 SET $PIECE(^IBE(359.1,IEN,10),"^",2)="NNNNNNPNNNN"
+5 SET $PIECE(^IBE(359.1,IEN,10),"^",4)="NNNNNNPNNNN"
+6 QUIT
+7 ;
UNCOMP ; -- uncompile all forms --
+1 NEW ZTQUEUED
+2 DO MES^XPDUTL(">>> Now uncompiling all Encounter Forms.")
+3 SET ZTQUEUED=1
+4 DO RECMPALL^IBDF19
+5 DO MES^XPDUTL(" Okay, forms will be recompiled as they are printed.")
+6 QUIT
+7 ;
RECOMP ; Recompile all forms in file 359.2
+1 NEW C,X,COUNT,CNT,COLWIDTH,IBDFSA,IBFORMID,IBBDT,IBEDT,IBDAY,LBEGIN,LEND,NODE10,POP,PRIORPG,QUIT
+2 ;
+3 SET IBBDT=$HOROLOG
+4 SET COUNT=$PIECE(^IBD(359.2,0),"^",4)
+5 ;
+6 DO MES^XPDUTL(">>> I am going to recompile all "_COUNT_" entries in your FORM SPECS file (359.2)")
+7 DO MES^XPDUTL(">>> Recompilation Started at "_$$HTE^XLFDT(IBBDT))
+8 DO MES^XPDUTL(">>> This may take awhile... (about 5 seconds per entry on an unloaded system)")
+9 ;
+10 SET CNT=0
+11 SET IBFORMID=0
FOR
SET IBFORMID=$ORDER(^IBD(359.2,IBFORMID))
if 'IBFORMID
QUIT
Begin DoDot:1
+12 DO SCAN^IBDFBKS(IBFORMID)
+13 SET CNT=CNT+1
+14 IF '$DATA(ZTQUEUED)
IF '(CNT#10)
DO MES^XPDUTL(" "_CNT_" done, "_(COUNT-CNT)_" to go.")
End DoDot:1
+15 ;
+16 SET IBEDT=$HOROLOG
+17 DO MES^XPDUTL("")
+18 DO MES^XPDUTL(">>> Recompilation Complete at "_$$HTE^XLFDT(IBEDT))
+19 IF $DATA(IBBDT)
Begin DoDot:1
+20 ;additional seconds of over midnight
SET IBDAY=+IBEDT-(+IBBDT)*86400
+21 SET X=IBDAY+$PIECE(IBEDT,",",2)-$PIECE(IBBDT,",",2)
+22 DO MES^XPDUTL(">>> Elapse time for recompilation was: "_(X\3600)_" Hours, "_(X\60-(X\3600*60))_" Minutes, "_(X#60)_" Seconds")
+23 SET X=(X/COUNT)
+24 DO MES^XPDUTL(">>> Average Time per Entry was: "_(X\60-(X\3600*60))_" Minutes, "_(X#60)_" Seconds")
End DoDot:1
+25 QUIT
+26 ;
DEL ; -- delete unused field
+1 NEW DIK,DA,CNT
+2 SET DIK="^DD(357.613,"
SET DA(1)=357.613
+3 IF $DATA(^DD(357.613,.02))
Begin DoDot:1
+4 SET DA=.02
SET CNT=$GET(CNT)+1
+5 DO ^DIK
End DoDot:1
+6 IF $DATA(^DD(357.613,.06))
Begin DoDot:1
+7 SET CNT=$GET(CNT)+1
+8 SET DA=.06
+9 DO ^DIK
End DoDot:1
+10 ;
+11 KILL DIK,DA
+12 if $GET(CNT)
DO MES^XPDUTL(">>> Deleted "_$GET(CNT)_" unused field"_$SELECT($GET(CNT)=1:"",1:"s")_" in the Package Interface File")
+13 QUIT
