LRCAPV3.m

LRCAPV3 ;SLC/AM/DALOI/FHS - CONTINUE STORE OF CAP WORKLOAD TO 64.1 ; 5/1/99

 ;;5.2T9;LR;**1018**;Nov 17, 2004

 ;;5.2;LAB SERVICE;**105,263**;Sep 27, 1994

EN ;

 S:'$D(LRLOG) LRLOG=$P($G(^LAB(69.9,1,"NITE")),U,6)

 I $G(LRLOG) D LRDSS ; This line controls the addition of data to the WKLD LOG FILE (#64.03) FOR DSS LAB WORKLOAD RECORDING

 D BLDIN,STORE

 Q

BLDIN ;

 K DINUM G:$D(^LRO(64.1,LRIN,0))=1 BLDCD

 K DIC,DIE,DR,DA,DO S (X,DINUM,DA)=LRIN,DLAYGO=64.1,DIC(0)="LNM",DIC="^LRO(64.1,",DA(1)=64.1 D FILE^DICN

 S ^LRO(64.1,LRIN,1,0)="^64.11DA^"

BLDCD ;

 K DINUM G:$D(^LRO(64.1,LRIN,1,LRCDT,0))=1 BLDCC

 K DIC,DIE,DR,DA,DO S (X,DINUM,DA)=LRCDT,DLAYGO=64.1,DIC(0)="LNM",DA(2)=64.1,DA(1)=LRIN,DIC="^LRO(64.1,"_LRIN_",1," D FILE^DICN

 S ^LRO(64.1,LRIN,1,LRCDT,1,0)="^64.111PA^"

BLDCC ;

 K DINUM Q:$D(^LRO(64.1,LRIN,1,LRCDT,1,LRCC,0))=1

 K DIC,DIE,DR,DA,DO S (X,DINUM,DA)=LRCC,DLAYGO=64.1,DIC(0)="LNM",DA(3)=64.1,DA(2)=LRIN,DA(1)=LRCDT,DIC="^LRO(64.1,"_LRIN_",1,"_LRCDT_",1," D FILE^DICN

 I $D(^LRO(64.1,LRIN,1,LRCDT,1,LRCC,0))#2 D

 . S $P(^LRO(64.1,LRIN,1,LRCDT,1,LRCC,0),U,2)=1

 . S $P(^LRO(64.1,LRIN,1,LRCDT,1,LRCC,0),U,3)=$P($G(^LAM(LRCC,0)),U,10)

 S ^LRO(64.1,LRIN,1,LRCDT,1,LRCC,1,0)="^64.1111A^"

 K DIC,DIE,DR,DA,DO,DINUM,DLAYGO

 Q

STORE ;

 S LRCTM=("."_LRCTM)*10000

 F LRCTM=LRCTM:.001 Q:'($D(^LRO(64.1,LRIN,1,LRCDT,1,LRCC,1,LRCTM,0))#2)

 S LRZCNT=0

 S:$D(^LRO(64.1,LRIN,1,LRCDT,1,LRCC,1,0))#2 LRZCNT=$P(^(0),U,4)

 L +^LRO(64.1,LRIN,1,LRCDT,1,LRCC) S ^LRO(64.1,LRIN,1,LRCDT,1,LRCC,1,0)="^64.1111A^"_LRCTM_U_(LRZCNT+1)

 S ^LRO(64.1,LRIN,1,LRCDT,1,LRCC,1,LRCTM,0)=LRCTM_U_LRTS_U_LRCNT_U_U_U_LRLD_U_LRMA_U_LRLSS_U_LRACC_U_LRFILE_U_LROAD_U_LROAD1_U_LROAD2_U_$S($G(LRSPEC):LRSPEC,1:"")_U_LRRRL

 S ^LRO(64.1,LRIN,1,LRCDT,1,LRCC,1,LRCTM,0)=^(0)_U_LRRRL1_U_LRRRL2_U_LRRRL3_U_LRRRL4_U_U_LROL_U_LRIDT_U_LRUG_U_LRTEC_U_LRWA L -^LRO(64.1,LRIN,1,LRCDT,1,LRCC)

 Q  ;I LRFNUM=62.3 D SETQC

 Q

SETQC ;

 S LRQC=0

 L +^LRO(64.1,LRIN,1,LRCDT,1,LRCC,"S") I $D(^LRO(64.1,LRIN,1,LRCDT,1,LRCC,"S"))#2 S LRQC=+$P(^("S"),U,2)

 S $P(^LRO(64.1,LRIN,1,LRCDT,1,LRCC,"S"),U,2)=LRQC+LRCNT L -^LRO(64.1,LRIN,1,LRCDT,1,LRCC,"S")

 Q

LRDSS ; entry point for DSS/DMSS like projects

 ;Only patients from ^DPT( and LMIP BILLABLE or DSS Feeder=yes or

 ;suffix code = 9999 are passed to LRO(64.03 file

 Q:$P($G(LRX),U,2)'?5N1"."4N.5N  Q:$S($G(LRFNUM)'=2:1,$P(LRX,U,5):0,$P(LRX,U,16):0,+$P(LRX,".",2)=9999:0,1:1)

 S:'$D(^LRO(64.03,0))#2 ^LRO(64.03,0)="WKLD LOG FILE^64.03^"

 S LRDSS0=^LRO(64.03,0),LRDSS=$S($P(LRDSS0,U,3):$P(LRDSS0,U,3),1:1) F LRDSS=LRDSS:1 Q:'$D(^LRO(64.03,LRDSS,0))

 S $P(LRDSS0,U,3)=LRDSS,$P(LRDSS0,U,4)=$P(LRDSS0,U,4)+1,^LRO(64.03,0)=LRDSS0

 S ^LRO(64.03,LRDSS,0)=LRDSS_U_LRRRL1_U_LRFILE_U_LRCDT_"."_LRCTM_U_LRIN_U_LRRRL4_U_LRAA_U_LRTS_U_LRUG_U_LRRRL2_U_LRCC_U_LRIDT_U_LROAD_U_LROAD1_U_LROL_U_LRII_U_$S($G(LRSPEC):LRSPEC,1:"")

 K LRDSS0,LRDSS,LRDN0,LRDSFP,LRDSF

 Q

LRCAPV3   ;SLC/AM/DALOI/FHS - CONTINUE STORE OF CAP WORKLOAD TO 64.1 ; 5/1/99

 +1       ;;5.2T9;LR;**1018**;Nov 17, 2004

 +2       ;;5.2;LAB SERVICE;**105,263**;Sep 27, 1994

EN        ;

 +1        IF '$DATA(LRLOG)

               SET LRLOG=$PIECE($GET(^LAB(69.9,1,"NITE")),U,6)

 +2       ; This line controls the addition of data to the WKLD LOG FILE (#64.03) FOR DSS LAB WORKLOAD RECORDING

           IF $GET(LRLOG)

               DO LRDSS

 +3        DO BLDIN

           DO STORE

 +4        QUIT 

BLDIN     ;

 +1        KILL DINUM

           IF $DATA(^LRO(64.1,LRIN,0))=1

               GOTO BLDCD

 +2        KILL DIC,DIE,DR,DA,DO

           SET (X,DINUM,DA)=LRIN

           SET DLAYGO=64.1

           SET DIC(0)="LNM"

           SET DIC="^LRO(64.1,"

           SET DA(1)=64.1

           DO FILE^DICN

 +3        SET ^LRO(64.1,LRIN,1,0)="^64.11DA^"

BLDCD     ;

 +1        KILL DINUM

           IF $DATA(^LRO(64.1,LRIN,1,LRCDT,0))=1

               GOTO BLDCC

 +2        KILL DIC,DIE,DR,DA,DO

           SET (X,DINUM,DA)=LRCDT

           SET DLAYGO=64.1

           SET DIC(0)="LNM"

           SET DA(2)=64.1

           SET DA(1)=LRIN

           SET DIC="^LRO(64.1,"_LRIN_",1,"

           DO FILE^DICN

 +3        SET ^LRO(64.1,LRIN,1,LRCDT,1,0)="^64.111PA^"

BLDCC     ;

 +1        KILL DINUM

           IF $DATA(^LRO(64.1,LRIN,1,LRCDT,1,LRCC,0))=1

               QUIT 

 +2        KILL DIC,DIE,DR,DA,DO

           SET (X,DINUM,DA)=LRCC

           SET DLAYGO=64.1

           SET DIC(0)="LNM"

           SET DA(3)=64.1

           SET DA(2)=LRIN

           SET DA(1)=LRCDT

           SET DIC="^LRO(64.1,"_LRIN_",1,"_LRCDT_",1,"

           DO FILE^DICN

 +3        IF $DATA(^LRO(64.1,LRIN,1,LRCDT,1,LRCC,0))#2

               Begin DoDot:1

 +4                SET $PIECE(^LRO(64.1,LRIN,1,LRCDT,1,LRCC,0),U,2)=1

 +5                SET $PIECE(^LRO(64.1,LRIN,1,LRCDT,1,LRCC,0),U,3)=$PIECE($GET(^LAM(LRCC,0)),U,10)

               End DoDot:1

 +6        SET ^LRO(64.1,LRIN,1,LRCDT,1,LRCC,1,0)="^64.1111A^"

 +7        KILL DIC,DIE,DR,DA,DO,DINUM,DLAYGO

 +8        QUIT 

STORE     ;

 +1        SET LRCTM=("."_LRCTM)*10000

 +2        FOR LRCTM=LRCTM:.001

               IF '($DATA(^LRO(64.1,LRIN,1,LRCDT,1,LRCC,1,LRCTM,0))#2)

                   QUIT 

 +3        SET LRZCNT=0

 +4        IF $DATA(^LRO(64.1,LRIN,1,LRCDT,1,LRCC,1,0))#2

               SET LRZCNT=$PIECE(^(0),U,4)

 +5        LOCK +^LRO(64.1,LRIN,1,LRCDT,1,LRCC)

           SET ^LRO(64.1,LRIN,1,LRCDT,1,LRCC,1,0)="^64.1111A^"_LRCTM_U_(LRZCNT+1)

 +6        SET ^LRO(64.1,LRIN,1,LRCDT,1,LRCC,1,LRCTM,0)=LRCTM_U_LRTS_U_LRCNT_U_U_U_LRLD_U_LRMA_U_LRLSS_U_LRACC_U_LRFILE_U_LROAD_U_LROAD1_U_LROAD2_U_$SELECT($GET(LRSPEC):LRSPEC,1:"")_U_LRRRL

 +7        SET ^LRO(64.1,LRIN,1,LRCDT,1,LRCC,1,LRCTM,0)=^(0)_U_LRRRL1_U_LRRRL2_U_LRRRL3_U_LRRRL4_U_U_LROL_U_LRIDT_U_LRUG_U_LRTEC_U_LRWA

           LOCK -^LRO(64.1,LRIN,1,LRCDT,1,LRCC)

 +8       ;I LRFNUM=62.3 D SETQC

           QUIT 

 +9        QUIT 

SETQC     ;

 +1        SET LRQC=0

 +2        LOCK +^LRO(64.1,LRIN,1,LRCDT,1,LRCC,"S")

           IF $DATA(^LRO(64.1,LRIN,1,LRCDT,1,LRCC,"S"))#2

               SET LRQC=+$PIECE(^("S"),U,2)

 +3        SET $PIECE(^LRO(64.1,LRIN,1,LRCDT,1,LRCC,"S"),U,2)=LRQC+LRCNT

           LOCK -^LRO(64.1,LRIN,1,LRCDT,1,LRCC,"S")

 +4        QUIT 

LRDSS     ; entry point for DSS/DMSS like projects

 +1       ;Only patients from ^DPT( and LMIP BILLABLE or DSS Feeder=yes or

 +2       ;suffix code = 9999 are passed to LRO(64.03 file

 +3        IF $PIECE($GET(LRX),U,2)'?5N1"."4N.5N

               QUIT 

           IF $SELECT($GET(LRFNUM)'=2

               QUIT 

 +4        IF '$DATA(^LRO(64.03,0))#2

               SET ^LRO(64.03,0)="WKLD LOG FILE^64.03^"

 +5        SET LRDSS0=^LRO(64.03,0)

           SET LRDSS=$SELECT($PIECE(LRDSS0,U,3):$PIECE(LRDSS0,U,3),1:1)

           FOR LRDSS=LRDSS:1

               IF '$DATA(^LRO(64.03,LRDSS,0))

                   QUIT 

 +6        SET $PIECE(LRDSS0,U,3)=LRDSS

           SET $PIECE(LRDSS0,U,4)=$PIECE(LRDSS0,U,4)+1

           SET ^LRO(64.03,0)=LRDSS0

 +7        SET ^LRO(64.03,LRDSS,0)=LRDSS_U_LRRRL1_U_LRFILE_U_LRCDT_"."_LRCTM_U_LRIN_U_LRRRL4_U_LRAA_U_LRTS_U_LRUG_U_LRRRL2_U_LRCC_U_LRIDT_U_LROAD_U_LROAD1_U_LROL_U_LRII_U_$SELECT($GET(LRSPEC):LRSPEC,1:"")

 +8        KILL LRDSS0,LRDSS,LRDN0,LRDSFP,LRDSF

 +9        QUIT