source: WorldVistAEHR/trunk/r/UTILIZATION_MGMT_ROLLUP_LOCAL-IBQ/IBQLLD1.m@ 1789

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

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1IBQLLD1 ;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 ;
5LOAD ; -- 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 ;
16MULTI ; -- 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 ;
23GETDR ; -- 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
26GETDR1 ; -- 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 ;
30TRANSMIT ;
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
Note: See TracBrowser for help on using the repository browser.