IBQLLD1 ;LEB/MRY - LOAD UMR FILE ; 31-MAR-95
;;1.0;UTILIZATION MGMT ROLLUP LOCAL;**2,3,4**;Oct 01, 1995
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
LOAD ; -- edit, or add .01 field and admission review data
N IBDAY,DIC,DIE,DA,IBDAY,X,Y,J
S IBDATA=IBDATA(0),X=$P($P(IBDATA,"^"),":",2),DIC="^IBQ(538,",DIC(0)="L",DLAYGO=538 D ^DIC I Y>0 D
.; -- fill 0.n fields.
.S DA=$P(Y,"^"),DIE=DIC D GETDR,^DIE
.; -- fill 1.n fields.
.S IBDATA=IBDATA(1) D GETDR1,^DIE
.; -- fill multiple continued stay fields
.D MULTI
Q
;
MULTI ; -- edit, or add .01 field and continued stay data
S DA(1)=DA,DIC=DIC_DA(1)_",13,"
S IBDAY=1 F S IBDAY=$O(IBDATA(IBDAY)) Q:'IBDAY S IBDATA=IBDATA(IBDAY) D
.S X=$P($P(IBDATA,"^"),":",2),DIC(0)="L",DIC("P")=$P(^DD(538,13,0),"^",2)
.D ^DIC I Y>0 S DA=+Y,DIE=DIC D GETDR,^DIE
Q
;
GETDR ; -- data string
S DR="" F J=1:1:$L(IBDATA,"^")-1 S DR=DR_$P($P(IBDATA,"^",J+1),":")_"////"_$P($P(IBDATA,"^",J+1),":",2)_";"
Q
GETDR1 ; -- data string with no initial call to ^DIE.
S DR="" F J=1:1:$L(IBDATA,"^") S DR=DR_$P($P(IBDATA,"^",J),":")_"////"_$P($P(IBDATA,"^",J),":",2)_";"
Q
;
TRANSMIT ;
; -- transmit local message
K ^TMP("IBQLLD",$J),XMY
S XMY("G.IBQ ROLLUP")="",XMDUZ="IBQ MONITOR",XMSUB="National Rollup File loaded"
;
S ^TMP("IBQLLD",$J,1,0)="The Utilization Management Rollup has completed"_$S($G(IBQNLD)="L":".",1:" and is ready to transmit.")
S ^TMP("IBQLLD",$J,2,0)=" "
S ^TMP("IBQLLD",$J,3,0)=" Site: "_$P($$SITE^VASITE,"^",3)
S ^TMP("IBQLLD",$J,4,0)="Number of Records loaded: "_IBREC
S Y=IBBDT X ^DD("DD") S IBBDT1=Y S Y=IBEDT X ^DD("DD") S IBEDT1=Y
S ^TMP("IBQLLD",$J,5,0)=" Rollup Period: "_IBBDT1_" - "_IBEDT1
S Y=$S('$D(IBDNLD):"UNKNOWN",IBDNLD="N":"NATIONAL",IBDNLD="A":"ALL",IBDNLD="L":"LOCAL",1:"RANDOM & DISEASE")
S ^TMP("IBQLLD",$J,6,0)=" Rollup Type: "_Y_" CASES"
S XMTEXT="^TMP(""IBQLLD"",$J," D ^XMD
;
K IBBDT1,IBEDT1,Y
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBQLLD1 2012 printed Dec 13, 2024@02:41:16 Page 2
IBQLLD1 ;LEB/MRY - LOAD UMR FILE ; 31-MAR-95
+1 ;;1.0;UTILIZATION MGMT ROLLUP LOCAL;**2,3,4**;Oct 01, 1995
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 ;
LOAD ; -- edit, or add .01 field and admission review data
+1 NEW IBDAY,DIC,DIE,DA,IBDAY,X,Y,J
+2 SET IBDATA=IBDATA(0)
SET X=$PIECE($PIECE(IBDATA,"^"),":",2)
SET DIC="^IBQ(538,"
SET DIC(0)="L"
SET DLAYGO=538
DO ^DIC
IF Y>0
Begin DoDot:1
+3 ; -- fill 0.n fields.
+4 SET DA=$PIECE(Y,"^")
SET DIE=DIC
DO GETDR
DO ^DIE
+5 ; -- fill 1.n fields.
+6 SET IBDATA=IBDATA(1)
DO GETDR1
DO ^DIE
+7 ; -- fill multiple continued stay fields
+8 DO MULTI
End DoDot:1
+9 QUIT
+10 ;
MULTI ; -- edit, or add .01 field and continued stay data
+1 SET DA(1)=DA
SET DIC=DIC_DA(1)_",13,"
+2 SET IBDAY=1
FOR
SET IBDAY=$ORDER(IBDATA(IBDAY))
if 'IBDAY
QUIT
SET IBDATA=IBDATA(IBDAY)
Begin DoDot:1
+3 SET X=$PIECE($PIECE(IBDATA,"^"),":",2)
SET DIC(0)="L"
SET DIC("P")=$PIECE(^DD(538,13,0),"^",2)
+4 DO ^DIC
IF Y>0
SET DA=+Y
SET DIE=DIC
DO GETDR
DO ^DIE
End DoDot:1
+5 QUIT
+6 ;
GETDR ; -- data string
+1 SET DR=""
FOR J=1:1:$LENGTH(IBDATA,"^")-1
SET DR=DR_$PIECE($PIECE(IBDATA,"^",J+1),":")_"////"_$PIECE($PIECE(IBDATA,"^",J+1),":",2)_";"
+2 QUIT
GETDR1 ; -- data string with no initial call to ^DIE.
+1 SET DR=""
FOR J=1:1:$LENGTH(IBDATA,"^")
SET DR=DR_$PIECE($PIECE(IBDATA,"^",J),":")_"////"_$PIECE($PIECE(IBDATA,"^",J),":",2)_";"
+2 QUIT
+3 ;
TRANSMIT ;
+1 ; -- transmit local message
+2 KILL ^TMP("IBQLLD",$JOB),XMY
+3 SET XMY("G.IBQ ROLLUP")=""
SET XMDUZ="IBQ MONITOR"
SET XMSUB="National Rollup File loaded"
+4 ;
+5 SET ^TMP("IBQLLD",$JOB,1,0)="The Utilization Management Rollup has completed"_$SELECT($GET(IBQNLD)="L":".",1:" and is ready to transmit.")
+6 SET ^TMP("IBQLLD",$JOB,2,0)=" "
+7 SET ^TMP("IBQLLD",$JOB,3,0)=" Site: "_$PIECE($$SITE^VASITE,"^",3)
+8 SET ^TMP("IBQLLD",$JOB,4,0)="Number of Records loaded: "_IBREC
+9 SET Y=IBBDT
XECUTE ^DD("DD")
SET IBBDT1=Y
SET Y=IBEDT
XECUTE ^DD("DD")
SET IBEDT1=Y
+10 SET ^TMP("IBQLLD",$JOB,5,0)=" Rollup Period: "_IBBDT1_" - "_IBEDT1
+11 SET Y=$SELECT('$DATA(IBDNLD):"UNKNOWN",IBDNLD="N":"NATIONAL",IBDNLD="A":"ALL",IBDNLD="L":"LOCAL",1:"RANDOM & DISEASE")
+12 SET ^TMP("IBQLLD",$JOB,6,0)=" Rollup Type: "_Y_" CASES"
+13 SET XMTEXT="^TMP(""IBQLLD"",$J,"
DO ^XMD
+14 ;
+15 KILL IBBDT1,IBEDT1,Y
+16 QUIT
