MCPFTR.m

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

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