- LRAPKOEU ;DSS/FHS - AP CPRS DIALOG UTILITIES ROUTINE ; 3/4/16 4:02pm
- ;;5.2;LAB SERVICE;**462**;Sep 27, 1994;Build 44
- Q
- ;
- PRT ; Entry point for print File #60 AP CPRS entries.
- N I,J,X,Y,DA,DIC,DIE,DIR,DTOUT,DUOUT,DIRUT,DR,AV1,AV2,AV3,J,VAL,LRPAG,LRY
- N LREND,LRTST,LRSPEC,LRSCR,LRX,LINE,%ZIS,POP,I
- N ZTRTN,ZTIO,ZTDESC,ZTSAVE,ZTSK
- W @(IOF)
- I '$O(^LAB(60,"AV1",0)) D Q
- . W !,"There are no AP CPRS definitions in the file"
- S DIR(0)="SO^1:Laboratory Test (#60);2:CPRS AP Screen (#67.91)"
- S DIR("A")="Sort Report by "
- S DIR("?")="How do you want the report to be sorted"
- D ^DIR
- S LRY=Y_","_Y(0) ;W !,Y," ",Y(0),LREND=0
- S %ZIS="QN",%ZIS("A")="Print on what Device ",%ZIS("B")="HOME"
- D ^%ZIS K %ZIS G:$G(POP) PRTEND
- I IO'=IO(0)!($D(IO("Q"))) D G PRTEND
- . S ZTRTN="PRTTSK^LRAPKOEU",ZTIO="ION",ZTDESC="PRINT CPRS AP DIALOG LISTING "_Y(0)
- . S ZTSAVE("LRY*")="" D ^%ZTLOAD,^%ZISC
- . W !,$S($G(ZTSK):"Task # "_ZTSK,11:"Task Error")
- PRTTSK ;Entry point for TASK Printing
- S VAL="^LAB(60,""AV1"")",LRPAG=0,LINE=0
- F S VAL=$Q(@VAL) Q:$QS(VAL,2)'="AV1" D
- . I +LRY=1 S AV1($P(^LAB(60,$QS(VAL,3),0),U)_"["_$QS(VAL,3)_"]",$P(^LAB(69.71,$QS(VAL,4),0),U))=""
- . I +LRY=2 S AV2($P(^LAB(69.71,$QS(VAL,4),0),U),$P(^LAB(60,$QS(VAL,3),0),U)_"["_$QS(VAL,3)_"]")=""
- PO ;Print out put
- S LINE=1 I +LRY=1 D HDR1 D ;Lab Test, CPRS Screen
- . S LRTST="" F S LRTST=$O(AV1(LRTST)) Q:LRTST=""!($G(LREND)) D
- . . W !!,"TEST NAME: ",LRTST
- . . S LRSCR="" F S LRSCR=$O(AV1(LRTST,LRSCR)) Q:LRSCR=""!($G(LREND)) D
- . . . W !?5,"CPRS SCREEN: ",LRSCR D EPAGE Q:$G(LREND)
- I +LRY=2 D HDR1 D ;CPRS Screen,Lab Test
- . S LRSCR="" F S LRSCR=$O(AV2(LRSCR)) Q:LRSCR=""!($G(LREND)) D
- . . W !!,"CPRS Sreen Name: ",LRSCR Q:$G(LREND)
- . . S LRTST="" F S LRTST=$O(AV2(LRSCR,LRTST)) Q:LRTST=""!($G(LREND)) D
- . . . W !?5,"Laboratory Test: ",LRTST D EPAGE Q:$G(LREND)
- W !,$$CJ^XLFSTR("=================== END OF REPORT ===================",IOM)
- PRTEND ;
- D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
- Q
- HDR1 ;
- ;W @IOF
- S LRPAG=$G(LRPAG)+1,LINE=3 W !!,$$CJ^XLFSTR("REPORT SORTED BY: "_$P(LRY,",",2)_" PAGE: "_LRPAG,IOM),!,?10,"[#IEN]" Q
- ;
- EPAGE ;Line counter
- S LINE=$G(LINE)+3 Q:LINE<(IOSL-3)
- K DIR,DTOUT,DUOUT,DIRUT,Y
- S LINE=2 W !
- I $E(IOST,1)="C" S DIR(0)="E" D ^DIR K DIR I $G(Y)=0 S LREND=1 Q
- D HDR1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRAPKOEU 2350 printed Mar 13, 2025@21:11:56 Page 2
- LRAPKOEU ;DSS/FHS - AP CPRS DIALOG UTILITIES ROUTINE ; 3/4/16 4:02pm
- +1 ;;5.2;LAB SERVICE;**462**;Sep 27, 1994;Build 44
- +2 QUIT
- +3 ;
- PRT ; Entry point for print File #60 AP CPRS entries.
- +1 NEW I,J,X,Y,DA,DIC,DIE,DIR,DTOUT,DUOUT,DIRUT,DR,AV1,AV2,AV3,J,VAL,LRPAG,LRY
- +2 NEW LREND,LRTST,LRSPEC,LRSCR,LRX,LINE,%ZIS,POP,I
- +3 NEW ZTRTN,ZTIO,ZTDESC,ZTSAVE,ZTSK
- +4 WRITE @(IOF)
- +5 IF '$ORDER(^LAB(60,"AV1",0))
- Begin DoDot:1
- +6 WRITE !,"There are no AP CPRS definitions in the file"
- End DoDot:1
- QUIT
- +7 SET DIR(0)="SO^1:Laboratory Test (#60);2:CPRS AP Screen (#67.91)"
- +8 SET DIR("A")="Sort Report by "
- +9 SET DIR("?")="How do you want the report to be sorted"
- +10 DO ^DIR
- +11 ;W !,Y," ",Y(0),LREND=0
- SET LRY=Y_","_Y(0)
- +12 SET %ZIS="QN"
- SET %ZIS("A")="Print on what Device "
- SET %ZIS("B")="HOME"
- +13 DO ^%ZIS
- KILL %ZIS
- if $GET(POP)
- GOTO PRTEND
- +14 IF IO'=IO(0)!($DATA(IO("Q")))
- Begin DoDot:1
- +15 SET ZTRTN="PRTTSK^LRAPKOEU"
- SET ZTIO="ION"
- SET ZTDESC="PRINT CPRS AP DIALOG LISTING "_Y(0)
- +16 SET ZTSAVE("LRY*")=""
- DO ^%ZTLOAD
- DO ^%ZISC
- +17 WRITE !,$SELECT($GET(ZTSK):"Task # "_ZTSK,11:"Task Error")
- End DoDot:1
- GOTO PRTEND
- PRTTSK ;Entry point for TASK Printing
- +1 SET VAL="^LAB(60,""AV1"")"
- SET LRPAG=0
- SET LINE=0
- +2 FOR
- SET VAL=$QUERY(@VAL)
- if $QSUBSCRIPT(VAL,2)'="AV1"
- QUIT
- Begin DoDot:1
- +3 IF +LRY=1
- SET AV1($PIECE(^LAB(60,$QSUBSCRIPT(VAL,3),0),U)_"["_$QSUBSCRIPT(VAL,3)_"]",$PIECE(^LAB(69.71,$QSUBSCRIPT(VAL,4),0),U))=""
- +4 IF +LRY=2
- SET AV2($PIECE(^LAB(69.71,$QSUBSCRIPT(VAL,4),0),U),$PIECE(^LAB(60,$QSUBSCRIPT(VAL,3),0),U)_"["_$QSUBSCRIPT(VAL,3)_"]")=""
- End DoDot:1
- PO ;Print out put
- +1 ;Lab Test, CPRS Screen
- SET LINE=1
- IF +LRY=1
- DO HDR1
- Begin DoDot:1
- +2 SET LRTST=""
- FOR
- SET LRTST=$ORDER(AV1(LRTST))
- if LRTST=""!($GET(LREND))
- QUIT
- Begin DoDot:2
- +3 WRITE !!,"TEST NAME: ",LRTST
- +4 SET LRSCR=""
- FOR
- SET LRSCR=$ORDER(AV1(LRTST,LRSCR))
- if LRSCR=""!($GET(LREND))
- QUIT
- Begin DoDot:3
- +5 WRITE !?5,"CPRS SCREEN: ",LRSCR
- DO EPAGE
- if $GET(LREND)
- QUIT
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +6 ;CPRS Screen,Lab Test
- IF +LRY=2
- DO HDR1
- Begin DoDot:1
- +7 SET LRSCR=""
- FOR
- SET LRSCR=$ORDER(AV2(LRSCR))
- if LRSCR=""!($GET(LREND))
- QUIT
- Begin DoDot:2
- +8 WRITE !!,"CPRS Sreen Name: ",LRSCR
- if $GET(LREND)
- QUIT
- +9 SET LRTST=""
- FOR
- SET LRTST=$ORDER(AV2(LRSCR,LRTST))
- if LRTST=""!($GET(LREND))
- QUIT
- Begin DoDot:3
- +10 WRITE !?5,"Laboratory Test: ",LRTST
- DO EPAGE
- if $GET(LREND)
- QUIT
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +11 WRITE !,$$CJ^XLFSTR("=================== END OF REPORT ===================",IOM)
- PRTEND ;
- +1 DO ^%ZISC
- if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +2 QUIT
- HDR1 ;
- +1 ;W @IOF
- +2 SET LRPAG=$GET(LRPAG)+1
- SET LINE=3
- WRITE !!,$$CJ^XLFSTR("REPORT SORTED BY: "_$PIECE(LRY,",",2)_" PAGE: "_LRPAG,IOM),!,?10,"[#IEN]"
- QUIT
- +3 ;
- EPAGE ;Line counter
- +1 SET LINE=$GET(LINE)+3
- if LINE<(IOSL-3)
- QUIT
- +2 KILL DIR,DTOUT,DUOUT,DIRUT,Y
- +3 SET LINE=2
- WRITE !
- +4 IF $EXTRACT(IOST,1)="C"
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- IF $GET(Y)=0
- SET LREND=1
- QUIT
- +5 DO HDR1
- +6 QUIT
