IBQLLD1.m

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 ---IBQLLD1   2012     printed  Apr 09, 2024@21:43:31                                                                                                                                                                                                     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