- 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
