| 1 | IBQLLD1 ;LEB/MRY - LOAD UMR FILE ; 31-MAR-95
|
|---|
| 2 | ;;1.0;UTILIZATION MGMT ROLLUP LOCAL;**2,3,4**;Oct 01, 1995
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | LOAD ; -- edit, or add .01 field and admission review data
|
|---|
| 6 | N IBDAY,DIC,DIE,DA,IBDAY,X,Y,J
|
|---|
| 7 | S IBDATA=IBDATA(0),X=$P($P(IBDATA,"^"),":",2),DIC="^IBQ(538,",DIC(0)="L",DLAYGO=538 D ^DIC I Y>0 D
|
|---|
| 8 | .; -- fill 0.n fields.
|
|---|
| 9 | .S DA=$P(Y,"^"),DIE=DIC D GETDR,^DIE
|
|---|
| 10 | .; -- fill 1.n fields.
|
|---|
| 11 | .S IBDATA=IBDATA(1) D GETDR1,^DIE
|
|---|
| 12 | .; -- fill multiple continued stay fields
|
|---|
| 13 | .D MULTI
|
|---|
| 14 | Q
|
|---|
| 15 | ;
|
|---|
| 16 | MULTI ; -- edit, or add .01 field and continued stay data
|
|---|
| 17 | S DA(1)=DA,DIC=DIC_DA(1)_",13,"
|
|---|
| 18 | S IBDAY=1 F S IBDAY=$O(IBDATA(IBDAY)) Q:'IBDAY S IBDATA=IBDATA(IBDAY) D
|
|---|
| 19 | .S X=$P($P(IBDATA,"^"),":",2),DIC(0)="L",DIC("P")=$P(^DD(538,13,0),"^",2)
|
|---|
| 20 | .D ^DIC I Y>0 S DA=+Y,DIE=DIC D GETDR,^DIE
|
|---|
| 21 | Q
|
|---|
| 22 | ;
|
|---|
| 23 | GETDR ; -- data string
|
|---|
| 24 | S DR="" F J=1:1:$L(IBDATA,"^")-1 S DR=DR_$P($P(IBDATA,"^",J+1),":")_"////"_$P($P(IBDATA,"^",J+1),":",2)_";"
|
|---|
| 25 | Q
|
|---|
| 26 | GETDR1 ; -- data string with no initial call to ^DIE.
|
|---|
| 27 | S DR="" F J=1:1:$L(IBDATA,"^") S DR=DR_$P($P(IBDATA,"^",J),":")_"////"_$P($P(IBDATA,"^",J),":",2)_";"
|
|---|
| 28 | Q
|
|---|
| 29 | ;
|
|---|
| 30 | TRANSMIT ;
|
|---|
| 31 | ; -- transmit local message
|
|---|
| 32 | K ^TMP("IBQLLD",$J),XMY
|
|---|
| 33 | S XMY("G.IBQ ROLLUP")="",XMDUZ="IBQ MONITOR",XMSUB="National Rollup File loaded"
|
|---|
| 34 | ;
|
|---|
| 35 | S ^TMP("IBQLLD",$J,1,0)="The Utilization Management Rollup has completed"_$S($G(IBQNLD)="L":".",1:" and is ready to transmit.")
|
|---|
| 36 | S ^TMP("IBQLLD",$J,2,0)=" "
|
|---|
| 37 | S ^TMP("IBQLLD",$J,3,0)=" Site: "_$P($$SITE^VASITE,"^",3)
|
|---|
| 38 | S ^TMP("IBQLLD",$J,4,0)="Number of Records loaded: "_IBREC
|
|---|
| 39 | S Y=IBBDT X ^DD("DD") S IBBDT1=Y S Y=IBEDT X ^DD("DD") S IBEDT1=Y
|
|---|
| 40 | S ^TMP("IBQLLD",$J,5,0)=" Rollup Period: "_IBBDT1_" - "_IBEDT1
|
|---|
| 41 | S Y=$S('$D(IBDNLD):"UNKNOWN",IBDNLD="N":"NATIONAL",IBDNLD="A":"ALL",IBDNLD="L":"LOCAL",1:"RANDOM & DISEASE")
|
|---|
| 42 | S ^TMP("IBQLLD",$J,6,0)=" Rollup Type: "_Y_" CASES"
|
|---|
| 43 | S XMTEXT="^TMP(""IBQLLD"",$J," D ^XMD
|
|---|
| 44 | ;
|
|---|
| 45 | K IBBDT1,IBEDT1,Y
|
|---|
| 46 | Q
|
|---|
