- DGMTOPYT ;ALB/CAW - Means Test with Previous Year Threshold ;8/14/92
- ;;5.3;Registration;**33**;Aug 13, 1993
- ;
- EN ;
- I '$$RANGE^DGMTUTL("P") G ENQ
- W !! S %ZIS="PMQ" D ^%ZIS I POP G ENQ
- I '$D(IO("Q")) D MAIN G ENQ
- S Y=$$QUE
- ENQ ;
- D:'$D(ZTQUEUED) ^%ZISC
- K DFN,DGBEG,DGC,DGDATE,DGDFN,DGEND,DGIEN,DGLINE,DGPAGE,DGP,DGPAT,DGPT,DGSTOP,DGTST,VA,VAERR,^TMP("DGMTO",$J)
- Q
- ;
- QUE() ; -- que job
- ; return: did job que [ 1|yes 0|no ]
- ;
- K ZTSK,IO("Q")
- S ZTDESC="Previous Year Threshold Output",ZTRTN="MAIN^DGMTOPYT"
- F X="DGBEG","DGEND" S ZTSAVE(X)=""
- D ^%ZTLOAD W:$D(ZTSK) " (Task: ",ZTSK,")"
- Q $D(ZTSK)
- ;
- MAIN ;
- S DGDATE=DGBEG-.1,(DGIEN,DGSTOP,DGPAGE,DGPT)=0,$P(DGLINE,"-",IOM+1)=""
- D HDR
- F S DGDATE=$O(^DGMT(408.31,"AP",1,DGDATE)) Q:'DGDATE!(DGDATE>DGEND) F S DGIEN=$O(^DGMT(408.31,"AP",1,DGDATE,DGIEN)) Q:'DGIEN D Q:DGSTOP
- .Q:'$G(^DGMT(408.31,DGIEN,"PRIM"))
- .S DGDFN=$P(^DGMT(408.31,DGIEN,0),U,2),DGTST=$P(^DGMT(408.31,DGIEN,0),U)
- .S DFN=DGDFN D PID^VADPT
- .S ^TMP("DGMTO",$J,$P(^DPT(DGDFN,0),U))=DGDFN_"^"_VA("PID")_"^"_DGTST
- D PRNT
- D CLOSE^DGMTUTL
- Q
- HDR ; Header
- S DGC(1)="Means Test Using Previous Years Threshold"
- S DGC(2)="Date Range: "_$$FDATE^DGMTUTL(DGBEG)_" to "_$$FDATE^DGMTUTL(DGEND) D NOW^%DTC S DGC(3)="Run Date: "_$E($$FTIME^DGMTUTL(%),1,18)
- W:$E(IOST,1,2)["C-" @IOF F I=1:1:3 W !?(IOM-$L(DGC(I))/2),DGC(I)
- S DGPAGE=DGPAGE+1 W !?68,"Page ",DGPAGE,!,DGLINE,!
- W !?5,"Patient Name",?50," Patient ID ",?65,"Date of Test"
- W !?5,"------------",?50,"------------",?65,"------------",!
- Q
- PRNT ;Print patients
- U IO I '$D(^TMP("DGMTO",$J)) W !,"NO MEANS TEST WITH PREVIOUS YEARS THRESHOLD" Q
- F S DGPT=$O(^TMP("DGMTO",$J,DGPT)) Q:DGPT="" S DGPAT=^(DGPT) D Q:DGSTOP
- .W !,?5,$P(^DPT(+DGPAT,0),U),?50,$P(DGPAT,U,2),?65,$$FDATE^DGMTUTL($P(DGPAT,U,3))
- .D CHK
- Q
- ;
- CHK ;Check to pause on screen
- I ($Y+5)>IOSL,$E(IOST,1,2)="C-" D PAUSE S DGP=Y D:DGP HDR I 'DGP S DGSTOP=1 Q
- I $E(IOST,1,2)="P-",($Y+5)>IOSL D HDR Q
- Q
- PAUSE ;
- W ! S DIR(0)="E" D ^DIR K DIR W !
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGMTOPYT 2059 printed Feb 19, 2025@00:11:08 Page 2
- DGMTOPYT ;ALB/CAW - Means Test with Previous Year Threshold ;8/14/92
- +1 ;;5.3;Registration;**33**;Aug 13, 1993
- +2 ;
- EN ;
- +1 IF '$$RANGE^DGMTUTL("P")
- GOTO ENQ
- +2 WRITE !!
- SET %ZIS="PMQ"
- DO ^%ZIS
- IF POP
- GOTO ENQ
- +3 IF '$DATA(IO("Q"))
- DO MAIN
- GOTO ENQ
- +4 SET Y=$$QUE
- ENQ ;
- +1 if '$DATA(ZTQUEUED)
- DO ^%ZISC
- +2 KILL DFN,DGBEG,DGC,DGDATE,DGDFN,DGEND,DGIEN,DGLINE,DGPAGE,DGP,DGPAT,DGPT,DGSTOP,DGTST,VA,VAERR,^TMP("DGMTO",$JOB)
- +3 QUIT
- +4 ;
- QUE() ; -- que job
- +1 ; return: did job que [ 1|yes 0|no ]
- +2 ;
- +3 KILL ZTSK,IO("Q")
- +4 SET ZTDESC="Previous Year Threshold Output"
- SET ZTRTN="MAIN^DGMTOPYT"
- +5 FOR X="DGBEG","DGEND"
- SET ZTSAVE(X)=""
- +6 DO ^%ZTLOAD
- if $DATA(ZTSK)
- WRITE " (Task: ",ZTSK,")"
- +7 QUIT $DATA(ZTSK)
- +8 ;
- MAIN ;
- +1 SET DGDATE=DGBEG-.1
- SET (DGIEN,DGSTOP,DGPAGE,DGPT)=0
- SET $PIECE(DGLINE,"-",IOM+1)=""
- +2 DO HDR
- +3 FOR
- SET DGDATE=$ORDER(^DGMT(408.31,"AP",1,DGDATE))
- if 'DGDATE!(DGDATE>DGEND)
- QUIT
- FOR
- SET DGIEN=$ORDER(^DGMT(408.31,"AP",1,DGDATE,DGIEN))
- if 'DGIEN
- QUIT
- Begin DoDot:1
- +4 if '$GET(^DGMT(408.31,DGIEN,"PRIM"))
- QUIT
- +5 SET DGDFN=$PIECE(^DGMT(408.31,DGIEN,0),U,2)
- SET DGTST=$PIECE(^DGMT(408.31,DGIEN,0),U)
- +6 SET DFN=DGDFN
- DO PID^VADPT
- +7 SET ^TMP("DGMTO",$JOB,$PIECE(^DPT(DGDFN,0),U))=DGDFN_"^"_VA("PID")_"^"_DGTST
- End DoDot:1
- if DGSTOP
- QUIT
- +8 DO PRNT
- +9 DO CLOSE^DGMTUTL
- +10 QUIT
- HDR ; Header
- +1 SET DGC(1)="Means Test Using Previous Years Threshold"
- +2 SET DGC(2)="Date Range: "_$$FDATE^DGMTUTL(DGBEG)_" to "_$$FDATE^DGMTUTL(DGEND)
- DO NOW^%DTC
- SET DGC(3)="Run Date: "_$EXTRACT($$FTIME^DGMTUTL(%),1,18)
- +3 if $EXTRACT(IOST,1,2)["C-"
- WRITE @IOF
- FOR I=1:1:3
- WRITE !?(IOM-$LENGTH(DGC(I))/2),DGC(I)
- +4 SET DGPAGE=DGPAGE+1
- WRITE !?68,"Page ",DGPAGE,!,DGLINE,!
- +5 WRITE !?5,"Patient Name",?50," Patient ID ",?65,"Date of Test"
- +6 WRITE !?5,"------------",?50,"------------",?65,"------------",!
- +7 QUIT
- PRNT ;Print patients
- +1 USE IO
- IF '$DATA(^TMP("DGMTO",$JOB))
- WRITE !,"NO MEANS TEST WITH PREVIOUS YEARS THRESHOLD"
- QUIT
- +2 FOR
- SET DGPT=$ORDER(^TMP("DGMTO",$JOB,DGPT))
- if DGPT=""
- QUIT
- SET DGPAT=^(DGPT)
- Begin DoDot:1
- +3 WRITE !,?5,$PIECE(^DPT(+DGPAT,0),U),?50,$PIECE(DGPAT,U,2),?65,$$FDATE^DGMTUTL($PIECE(DGPAT,U,3))
- +4 DO CHK
- End DoDot:1
- if DGSTOP
- QUIT
- +5 QUIT
- +6 ;
- CHK ;Check to pause on screen
- +1 IF ($Y+5)>IOSL
- IF $EXTRACT(IOST,1,2)="C-"
- DO PAUSE
- SET DGP=Y
- if DGP
- DO HDR
- IF 'DGP
- SET DGSTOP=1
- QUIT
- +2 IF $EXTRACT(IOST,1,2)="P-"
- IF ($Y+5)>IOSL
- DO HDR
- QUIT
- +3 QUIT
- PAUSE ;
- +1 WRITE !
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- WRITE !
- +2 QUIT
- +3 ;
