ACRFPCRT.m

ACRFPCRT ;IHS/OIRM/DSD/THL,AEF - PRINT CERTIFYING STATEMENTS; [ 11/01/2001   9:44 AM ]

 ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001

 ;;ROUTINE TO PRINT CERTIFYING STATEMENTS

EN D EN1

EXIT ;

 Q

EN1 S ACR=0,ACRTXTYP=$P(ACRDOC0,U,4)

 F  S ACR=$O(^ACRDOCAC("AC",ACRDOCDA,ACR)) Q:'ACR  D

 .S D0=0

 .F  S D0=$O(^ACRDOCAC("AC",ACRDOCDA,ACR,D0)) Q:'D0  D

 ..S ACRCDA=$P(^ACRDOCAC(D0,0),U)

 ..W @IOF

 ..W !?4,"DOCUMENT: ",$S(ACRTXTYP=11:$P(ACRDOC0,U,2),1:$P(ACRDOC0,U))

 ..W !?4,$P(^ACRAPVC(ACRCDA,0),U)," CERTIFICATION"

 ..W !!

 ..N DXS,DIP,DC,DN

 ..D ^ACRPCRT

 Q

ACRFPCRT  ;IHS/OIRM/DSD/THL,AEF - PRINT CERTIFYING STATEMENTS; [ 11/01/2001   9:44 AM ]

 +1       ;;2.1;ADMIN RESOURCE MGT SYSTEM;;NOV 05, 2001

 +2       ;;ROUTINE TO PRINT CERTIFYING STATEMENTS

EN         DO EN1

EXIT      ;

 +1        QUIT 

EN1        SET ACR=0

           SET ACRTXTYP=$PIECE(ACRDOC0,U,4)

 +1        FOR 

               SET ACR=$ORDER(^ACRDOCAC("AC",ACRDOCDA,ACR))

               IF 'ACR

                   QUIT 

               Begin DoDot:1

 +2                SET D0=0

 +3                FOR 

                       SET D0=$ORDER(^ACRDOCAC("AC",ACRDOCDA,ACR,D0))

                       IF 'D0

                           QUIT 

                       Begin DoDot:2

 +4                        SET ACRCDA=$PIECE(^ACRDOCAC(D0,0),U)

 +5                        WRITE @IOF

 +6                        WRITE !?4,"DOCUMENT: ",$SELECT(ACRTXTYP=11:$PIECE(ACRDOC0,U,2),1:$PIECE(ACRDOC0,U))

 +7                        WRITE !?4,$PIECE(^ACRAPVC(ACRCDA,0),U)," CERTIFICATION"

 +8                        WRITE !!

 +9                        NEW DXS,DIP,DC,DN

 +10                       DO ^ACRPCRT

                       End DoDot:2

               End DoDot:1

 +11       QUIT