MCPFTR ;WISC/MLH-RELEASE A PFT REPORT ;8/24/92 10:08
;;2.3;Medicine;;09/13/1996
;;
S FINIS=0 ; done-processing flag
FOR D Q:FINIS
. S DIC="^MCAR(700,",DIC(0)="AEMQZ"
. D ^DIC ; select a report to release
. K DIC
. IF Y=-1 S FINIS=1 ; we're through processing
. ELSE D ; process this entry
.. S MCARGDA=+Y,RELSTAT=$P($G(^MCAR(700,MCARGDA,2)),U)
.. IF RELSTAT="Y" W !!,"This report has already been released. Try again.",!!
.. ELSE D ; ask for print and confirm release
... S DIR(0)="Y",DIR("A")="Do you want to print this report before releasing it"
... D ^DIR
... K DIR
... I Y D SUM^MCPFTP ; print the report
... S DIR(0)="Y",DIR("A")="Sure you wish to RELEASE this report",DIR("B")="N"
... D ^DIR
... K DIR
... IF Y D ; release the report
.... S $P(^MCAR(700,MCARGDA,2),U)="Y" ; release node on PFT
.... W !!,"*** REPORT RELEASED ***",!!
.... Q
... ;END IF
... ;
... Q
.. ;END IF
.. ;
.. Q
. ;END IF
. ;
. Q
;END FOR
;
K FINIS
QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCPFTR 1142 printed Nov 22, 2024@17:26:12 Page 2
MCPFTR ;WISC/MLH-RELEASE A PFT REPORT ;8/24/92 10:08
+1 ;;2.3;Medicine;;09/13/1996
+2 ;;
+3 ; done-processing flag
SET FINIS=0
+4 FOR
Begin DoDot:1
+5 SET DIC="^MCAR(700,"
SET DIC(0)="AEMQZ"
+6 ; select a report to release
DO ^DIC
+7 KILL DIC
+8 ; we're through processing
IF Y=-1
SET FINIS=1
+9 ; process this entry
IF '$TEST
Begin DoDot:2
+10 SET MCARGDA=+Y
SET RELSTAT=$PIECE($GET(^MCAR(700,MCARGDA,2)),U)
+11 IF RELSTAT="Y"
WRITE !!,"This report has already been released. Try again.",!!
+12 ; ask for print and confirm release
IF '$TEST
Begin DoDot:3
+13 SET DIR(0)="Y"
SET DIR("A")="Do you want to print this report before releasing it"
+14 DO ^DIR
+15 KILL DIR
+16 ; print the report
IF Y
DO SUM^MCPFTP
+17 SET DIR(0)="Y"
SET DIR("A")="Sure you wish to RELEASE this report"
SET DIR("B")="N"
+18 DO ^DIR
+19 KILL DIR
+20 ; release the report
IF Y
Begin DoDot:4
+21 ; release node on PFT
SET $PIECE(^MCAR(700,MCARGDA,2),U)="Y"
+22 WRITE !!,"*** REPORT RELEASED ***",!!
+23 QUIT
End DoDot:4
+24 ;END IF
+25 ;
+26 QUIT
End DoDot:3
+27 ;END IF
+28 ;
+29 QUIT
End DoDot:2
+30 ;END IF
+31 ;
+32 QUIT
End DoDot:1
if FINIS
QUIT
+33 ;END FOR
+34 ;
+35 KILL FINIS
+36 QUIT
