- LRQCLOG ;SLC/CJS - QUALITY CONTROL LOGGING ;3/28/90 15:20 ;
- ;;5.2;LAB SERVICE;**9,89**;Sep 27, 1994
- D WHICH G END:LRDPF<1
- ASK S (LRINC,LREND)=0,DIC=LRDPF,DIC(0)="AEQ" D ^LRDPA G LRQCLOG:(LRDFN=-1)!$D(DUOUT)!$D(DTOUT)
- TEST S DIC="^LAB(60,",DIC(0)="AEMOQ" D ^DIC G ASK:Y<1 S LRTEST=+Y
- L2 S %DT="ET",%DT("A")="Collection date & time: ",%DT("B")="NOW" D DATE^LRWU G END:Y<1 S LRNOW=Y
- S LRINC=LRINC+1,LRNT=$$ADDDATE^LRAFUNC1(LRNOW,0,0,0,LRINC)
- S LRODT=LRNOW\1,LRAD=LRODT,LRIDT=(9999999-LRNT),LRCDT=LRNOW_"^1",LRSAMP="",LRSPEC=$S(62.3=+LRDPF:$P(^LAB(62.3,DFN,0),U,5),1:""),LROUTINE=$P(^LAB(69.9,1,3),U,2)
- I LRSPEC="" S LRTSTS=LRTEST,LRFLOG="^^MI" D GS^LRORD3 I $D(LROT)!LREND G END
- S:'$D(^LRO(69,LRODT,0)) ^(0)=$P(^LRO(69,0),U,1,2)_U_LRODT_U_(1+$P(^(0),U,4)),^LRO(69,LRODT,0)=LRODT,^LRO(69,"B",LRODT,LRODT)=""
- D ORDER^LROW2
- L +^LRO(69,LRODT)
- S LRSN=1+$S($D(^LRO(69,LRODT,1,0)):$P(^(0),U,3),1:0),LRSUM=1+$S($D(^LRO(69,LRODT,1,0)):$P(^(0),U,4),1:0)
- QSN IF $D(^LRO(69,LRODT,1,LRSN,0)) S LRSN=LRSN+1 G QSN
- S DA=LRODT,^LRO(69,LRODT,1,LRSN,0)=LRDFN_U_DUZ_U_LRSAMP_U_U_LRNOW_"^^UNK^"_LRNOW,^(.1)=LRORD,^(1)=LRCDT_U_DUZ_U_"C",^(2,0)="^69.03PA^1^1",^(1,0)=LRTEST_U_LROUTINE
- S ^LRO(69,LRODT,1,LRSN,4,0)="^69.02PA^1^1",^(1,0)=LRSPEC
- S ^LRO(69,LRODT,1,LRSN,2,"B",LRTEST,1)="",^LRO(69,LRODT,1,"AA",LRDFN,LRSN)="",^LRO(69,"C",LRORD,LRODT,LRSN)="",^LRO(69,LRODT,1,0)="^69.01PA^"_LRSN_U_LRSUM
- L -^LRO(69,LRODT)
- K ^TMP("LR",$J,"TMP") S LRTSTS=0,LRLLOC="" D ^LRWLST
- G TEST
- EN ;
- ADDNAME D WHICH G END:LRDPF<1
- S (DIC,DLAYGO)=+LRDPF,DIC(0)="AQLEM" D ANY^LRDPA G END:LRDFN<1
- S DA=DFN,DR=".01:10",DR(2,62.31)=".01;1;2",DIE=U_$P(LRDPF,U,2)
- S LRGLB=DIE_DA_")" L +@LRGLB:1 I '$T W !!?7,"Someone else is editing this entry ",!,$C(7) G END
- D ^DIE L -@LRGLB G END
- WHICH S LRDPF=0,DIR(0)="SO^62.3:Lab Control Name;67:Referral Patient;67.1:Research;67.2:Sterilizer;67.3:Environmental",DIR("A")="FILE" D ^DIR S LRDPF=Y
- Q:Y<1!($D(DIRUT)) S LRDPF=+Y_^DIC(+Y,0,"GL")
- W !!
- Q
- END K %,A,DIC,DL,DX,H8,J,K,LRAA,LRACC,LRAD,LRAN,LRCDT,LRDFN,LRCS,LRCSN,LRDPF,LREAL,LREND,LRFLOG,LRIDT,LRIN,LRINC,LRIX,LRLBLBP,LRLLOC,LRNT,LRODT,LROT,LROUTINE,LRPR,LRPRAC,LRRB,LRSAMP,LRSN,LRSPEC,LRSSP,LRSS,LRST,LRSUM,LRTEST,LRTN,LRTS
- K LRUNQ,LRURG,LRWL0,LRWLC,S,X,Y,Z,LRDUZ,LRCAPLOC,DIC,DFN,DR,DIE,DD,D1,DIG,DIH,DIU,DIV,DLAYGO,DO,DPF,DQ,I,K,LRI,LRLABKY,LRLBL,LRLWC,LRNOW,LRODTSV,LROLLOC,LRORIFN,LRSNSV,LRTNSV,LRTREA,LRYR
- K %DT,%Y,A1,DIWL,DIWR,H,I5,LRCCOM,LRGCOM,LRNCWL,LRNIDT,LROCN,LROID,LROLRDFN,LRORD,LROSN,LRPHSET,LRSPCDSC,LRTJ,P,PNM,R,S5,X1,X2,ZTSK,DLAYGO,LRGLB
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRQCLOG 2561 printed Jan 18, 2025@03:20:28 Page 2
- LRQCLOG ;SLC/CJS - QUALITY CONTROL LOGGING ;3/28/90 15:20 ;
- +1 ;;5.2;LAB SERVICE;**9,89**;Sep 27, 1994
- +2 DO WHICH
- if LRDPF<1
- GOTO END
- ASK SET (LRINC,LREND)=0
- SET DIC=LRDPF
- SET DIC(0)="AEQ"
- DO ^LRDPA
- if (LRDFN=-1)!$DATA(DUOUT)!$DATA(DTOUT)
- GOTO LRQCLOG
- TEST SET DIC="^LAB(60,"
- SET DIC(0)="AEMOQ"
- DO ^DIC
- if Y<1
- GOTO ASK
- SET LRTEST=+Y
- L2 SET %DT="ET"
- SET %DT("A")="Collection date & time: "
- SET %DT("B")="NOW"
- DO DATE^LRWU
- if Y<1
- GOTO END
- SET LRNOW=Y
- +1 SET LRINC=LRINC+1
- SET LRNT=$$ADDDATE^LRAFUNC1(LRNOW,0,0,0,LRINC)
- +2 SET LRODT=LRNOW\1
- SET LRAD=LRODT
- SET LRIDT=(9999999-LRNT)
- SET LRCDT=LRNOW_"^1"
- SET LRSAMP=""
- SET LRSPEC=$SELECT(62.3=+LRDPF:$PIECE(^LAB(62.3,DFN,0),U,5),1:"")
- SET LROUTINE=$PIECE(^LAB(69.9,1,3),U,2)
- +3 IF LRSPEC=""
- SET LRTSTS=LRTEST
- SET LRFLOG="^^MI"
- DO GS^LRORD3
- IF $DATA(LROT)!LREND
- GOTO END
- +4 if '$DATA(^LRO(69,LRODT,0))
- SET ^(0)=$PIECE(^LRO(69,0),U,1,2)_U_LRODT_U_(1+$PIECE(^(0),U,4))
- SET ^LRO(69,LRODT,0)=LRODT
- SET ^LRO(69,"B",LRODT,LRODT)=""
- +5 DO ORDER^LROW2
- +6 LOCK +^LRO(69,LRODT)
- +7 SET LRSN=1+$SELECT($DATA(^LRO(69,LRODT,1,0)):$PIECE(^(0),U,3),1:0)
- SET LRSUM=1+$SELECT($DATA(^LRO(69,LRODT,1,0)):$PIECE(^(0),U,4),1:0)
- QSN IF $DATA(^LRO(69,LRODT,1,LRSN,0))
- SET LRSN=LRSN+1
- GOTO QSN
- +1 SET DA=LRODT
- SET ^LRO(69,LRODT,1,LRSN,0)=LRDFN_U_DUZ_U_LRSAMP_U_U_LRNOW_"^^UNK^"_LRNOW
- SET ^(.1)=LRORD
- SET ^(1)=LRCDT_U_DUZ_U_"C"
- SET ^(2,0)="^69.03PA^1^1"
- SET ^(1,0)=LRTEST_U_LROUTINE
- +2 SET ^LRO(69,LRODT,1,LRSN,4,0)="^69.02PA^1^1"
- SET ^(1,0)=LRSPEC
- +3 SET ^LRO(69,LRODT,1,LRSN,2,"B",LRTEST,1)=""
- SET ^LRO(69,LRODT,1,"AA",LRDFN,LRSN)=""
- SET ^LRO(69,"C",LRORD,LRODT,LRSN)=""
- SET ^LRO(69,LRODT,1,0)="^69.01PA^"_LRSN_U_LRSUM
- +4 LOCK -^LRO(69,LRODT)
- +5 KILL ^TMP("LR",$JOB,"TMP")
- SET LRTSTS=0
- SET LRLLOC=""
- DO ^LRWLST
- +6 GOTO TEST
- EN ;
- ADDNAME DO WHICH
- if LRDPF<1
- GOTO END
- +1 SET (DIC,DLAYGO)=+LRDPF
- SET DIC(0)="AQLEM"
- DO ANY^LRDPA
- if LRDFN<1
- GOTO END
- +2 SET DA=DFN
- SET DR=".01:10"
- SET DR(2,62.31)=".01;1;2"
- SET DIE=U_$PIECE(LRDPF,U,2)
- +3 SET LRGLB=DIE_DA_")"
- LOCK +@LRGLB:1
- IF '$TEST
- WRITE !!?7,"Someone else is editing this entry ",!,$CHAR(7)
- GOTO END
- +4 DO ^DIE
- LOCK -@LRGLB
- GOTO END
- WHICH SET LRDPF=0
- SET DIR(0)="SO^62.3:Lab Control Name;67:Referral Patient;67.1:Research;67.2:Sterilizer;67.3:Environmental"
- SET DIR("A")="FILE"
- DO ^DIR
- SET LRDPF=Y
- +1 if Y<1!($DATA(DIRUT))
- QUIT
- SET LRDPF=+Y_^DIC(+Y,0,"GL")
- +2 WRITE !!
- +3 QUIT
- END KILL %,A,DIC,DL,DX,H8,J,K,LRAA,LRACC,LRAD,LRAN,LRCDT,LRDFN,LRCS,LRCSN,LRDPF,LREAL,LREND,LRFLOG,LRIDT,LRIN,LRINC,LRIX,LRLBLBP,LRLLOC,LRNT,LRODT,LROT,LROUTINE,LRPR,LRPRAC,LRRB,LRSAMP,LRSN,LRSPEC,LRSSP,LRSS,LRST,LRSUM,LRTEST,LRTN,LRTS
- +1 KILL LRUNQ,LRURG,LRWL0,LRWLC,S,X,Y,Z,LRDUZ,LRCAPLOC,DIC,DFN,DR,DIE,DD,D1,DIG,DIH,DIU,DIV,DLAYGO,DO,DPF,DQ,I,K,LRI,LRLABKY,LRLBL,LRLWC,LRNOW,LRODTSV,LROLLOC,LRORIFN,LRSNSV,LRTNSV,LRTREA,LRYR
- +2 KILL %DT,%Y,A1,DIWL,DIWR,H,I5,LRCCOM,LRGCOM,LRNCWL,LRNIDT,LROCN,LROID,LROLRDFN,LRORD,LROSN,LRPHSET,LRSPCDSC,LRTJ,P,PNM,R,S5,X1,X2,ZTSK,DLAYGO,LRGLB
- +3 QUIT