AQAOPC54 ; IHS/ORDC/LJF - PRINT PROGRESS REPORT-ACTIONS ;
;;1.01;QAI MANAGEMENT;;OCT 05, 1995
;
;This rtns does the actual printing of the action plans for the
;quarterly progress report. There are 2 entry points, one for
;hard-copy prints and one for ASCII-format captures.
;
ACTION ;ENTRY POINT from ^AQAOPC52 hard copy print
W !!,"Action #",?13,"Plan Status",?43,"Implemented",?56,"Reviewed"
W ?67,"Closed",!,AQAOLIN2
S AQAOAC=0
F S AQAOAC=$O(^TMP("AQAOPC5B",$J,AQAOIND,AQAOAC)) Q:AQAOAC="" Q:AQAOSTOP=U D
.K ^UTILITY("DIQ1",$J) S DIC="^AQAO(5,",DR=".01:.06;.15",DA=AQAOAC
.S DIQ(0)="IE" D EN^DIQ1
.W !,^UTILITY("DIQ1",$J,9002168.5,AQAOAC,.01,"E") ;plan id #
.W ?13,$E(^UTILITY("DIQ1",$J,9002168.5,AQAOAC,.05,"E"),1,30) ;status
.W ?44 S X=^UTILITY("DIQ1",$J,9002168.5,AQAOAC,.03,"I") I X>0 D
..W $J($$FMTE^XLFDT(X,"2D"),8) ;implementation date
.W ?56 S X=^UTILITY("DIQ1",$J,9002168.5,AQAOAC,.04,"I") I X>0 D
..W $J($$FMTE^XLFDT(X,"2D"),8) ;proposed review date
.W ?68 S X=^UTILITY("DIQ1",$J,9002168.5,AQAOAC,.06,"I") I X>0 D
..W $J($$FMTE^XLFDT(X,"2D"),8) ;date plan closed
.W !?1,"Action Type: ",^UTILITY("DIQ1",$J,9002168.5,AQAOAC,.02,"E")
.W !?3,"Next Step: ",^UTILITY("DIQ1",$J,9002168.5,AQAOAC,.15,"E")
.W ! K ^UTILITY("DIQ1",$J)
Q
;
;
ACTDLM ;ENTRY POINT from ^AQAOPC53 ASCII capture print
W !!
F I="Action #","Plan Status","Implemented","Reviewed","Closed" W I,AQAODLM
W ! S AQAOAC=0
F S AQAOAC=$O(^TMP("AQAOPC5B",$J,AQAOIND,AQAOAC)) Q:AQAOAC="" Q:AQAOSTOP=U D
.Q:'$D(^AQAO(5,AQAOAC,0)) S AQAOSTR=^(0)
.W !,$P(AQAOSTR,U),AQAODLM ;action #
.S Y=$P(AQAOSTR,U,5),C=$P(^DD(9002168.5,.05,0),U,2) D Y^DIQ W Y,AQAODLM
.S Y=$P(AQAOSTR,U,3),C=$P(^DD(9002168.5,.03,0),U,2) D Y^DIQ W Y,AQAODLM
.S Y=$P(AQAOSTR,U,4),C=$P(^DD(9002168.5,.04,0),U,2) D Y^DIQ W Y,AQAODLM
.S Y=$P(AQAOSTR,U,6),C=$P(^DD(9002168.5,.06,0),U,2) D Y^DIQ W Y,AQAODLM
.S Y=$P(AQAOSTR,U,2),C=$P(^DD(9002168.5,.02,0),U,2) D Y^DIQ W Y,AQAODLM
.S Y=$P(AQAOSTR,U,15),C=$P(^DD(9002168.5,.15,0),U,2) D Y^DIQ W Y
Q
AQAOPC54 ; IHS/ORDC/LJF - PRINT PROGRESS REPORT-ACTIONS ;
+1 ;;1.01;QAI MANAGEMENT;;OCT 05, 1995
+2 ;
+3 ;This rtns does the actual printing of the action plans for the
+4 ;quarterly progress report. There are 2 entry points, one for
+5 ;hard-copy prints and one for ASCII-format captures.
+6 ;
ACTION ;ENTRY POINT from ^AQAOPC52 hard copy print
+1 WRITE !!,"Action #",?13,"Plan Status",?43,"Implemented",?56,"Reviewed"
+2 WRITE ?67,"Closed",!,AQAOLIN2
+3 SET AQAOAC=0
+4 FOR
SET AQAOAC=$ORDER(^TMP("AQAOPC5B",$JOB,AQAOIND,AQAOAC))
IF AQAOAC=""
QUIT
IF AQAOSTOP=U
QUIT
Begin DoDot:1
+5 KILL ^UTILITY("DIQ1",$JOB)
SET DIC="^AQAO(5,"
SET DR=".01:.06;.15"
SET DA=AQAOAC
+6 SET DIQ(0)="IE"
DO EN^DIQ1
+7 ;plan id #
WRITE !,^UTILITY("DIQ1",$JOB,9002168.5,AQAOAC,.01,"E")
+8 ;status
WRITE ?13,$EXTRACT(^UTILITY("DIQ1",$JOB,9002168.5,AQAOAC,.05,"E"),1,30)
+9 WRITE ?44
SET X=^UTILITY("DIQ1",$JOB,9002168.5,AQAOAC,.03,"I")
IF X>0
Begin DoDot:2
+10 ;implementation date
WRITE $JUSTIFY($$FMTE^XLFDT(X,"2D"),8)
End DoDot:2
+11 WRITE ?56
SET X=^UTILITY("DIQ1",$JOB,9002168.5,AQAOAC,.04,"I")
IF X>0
Begin DoDot:2
+12 ;proposed review date
WRITE $JUSTIFY($$FMTE^XLFDT(X,"2D"),8)
End DoDot:2
+13 WRITE ?68
SET X=^UTILITY("DIQ1",$JOB,9002168.5,AQAOAC,.06,"I")
IF X>0
Begin DoDot:2
+14 ;date plan closed
WRITE $JUSTIFY($$FMTE^XLFDT(X,"2D"),8)
End DoDot:2
+15 WRITE !?1,"Action Type: ",^UTILITY("DIQ1",$JOB,9002168.5,AQAOAC,.02,"E")
+16 WRITE !?3,"Next Step: ",^UTILITY("DIQ1",$JOB,9002168.5,AQAOAC,.15,"E")
+17 WRITE !
KILL ^UTILITY("DIQ1",$JOB)
End DoDot:1
+18 QUIT
+19 ;
+20 ;
ACTDLM ;ENTRY POINT from ^AQAOPC53 ASCII capture print
+1 WRITE !!
+2 FOR I="Action #","Plan Status","Implemented","Reviewed","Closed"
WRITE I,AQAODLM
+3 WRITE !
SET AQAOAC=0
+4 FOR
SET AQAOAC=$ORDER(^TMP("AQAOPC5B",$JOB,AQAOIND,AQAOAC))
IF AQAOAC=""
QUIT
IF AQAOSTOP=U
QUIT
Begin DoDot:1
+5 IF '$DATA(^AQAO(5,AQAOAC,0))
QUIT
SET AQAOSTR=^(0)
+6 ;action #
WRITE !,$PIECE(AQAOSTR,U),AQAODLM
+7 SET Y=$PIECE(AQAOSTR,U,5)
SET C=$PIECE(^DD(9002168.5,.05,0),U,2)
DO Y^DIQ
WRITE Y,AQAODLM
+8 SET Y=$PIECE(AQAOSTR,U,3)
SET C=$PIECE(^DD(9002168.5,.03,0),U,2)
DO Y^DIQ
WRITE Y,AQAODLM
+9 SET Y=$PIECE(AQAOSTR,U,4)
SET C=$PIECE(^DD(9002168.5,.04,0),U,2)
DO Y^DIQ
WRITE Y,AQAODLM
+10 SET Y=$PIECE(AQAOSTR,U,6)
SET C=$PIECE(^DD(9002168.5,.06,0),U,2)
DO Y^DIQ
WRITE Y,AQAODLM
+11 SET Y=$PIECE(AQAOSTR,U,2)
SET C=$PIECE(^DD(9002168.5,.02,0),U,2)
DO Y^DIQ
WRITE Y,AQAODLM
+12 SET Y=$PIECE(AQAOSTR,U,15)
SET C=$PIECE(^DD(9002168.5,.15,0),U,2)
DO Y^DIQ
WRITE Y
End DoDot:1
+13 QUIT
