ACRFSSPO.m

ACRFSSPO ;IHS/OIRM/DSD/THL,AEF - REVIEW ITEMS FOR PO PRINT; [ 11/01/2001   9:44 AM ]

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

 ;;ROUTINE TO REVIEW ITEMS FOR PO PRINT

EN D EN1

EXIT K ACR,ACRDSC,ACRDSC1,ACRADSC

 Q

EN1 S (ACR,ACRJ,ACRPOT,ACRPOTOT,ACRPOL,ACRPOL1)=0

 S (ACRPOPG,ACRDC)=1

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

 .Q:'$D(^ACRSS(ACR,0))!'$D(^ACRSS(ACR,"DT"))

 .S ACRSSDT=^ACRSS(ACR,"DT")

 .S ACRJ=ACRJ+1

 .S ACRDSC=$G(^ACRSS(ACR,"DESC"))

 .S ACRDSC1=$G(^ACRSS(ACR,"NOTES"))

 .S ACRADSC=$P($G(^ACRSS(ACR,1,0)),U,3)

 .S ACRNMS=$G(^ACRSS(ACR,"NMS"))

 .S:$P(ACRNMS,U)]""!($P(ACRNMS,U,2)]"") ACRPOL=ACRPOL+1

 .S ACRPOTOT=ACRPOTOT+$P(ACRSSDT,U,9)

 .S ACRPOT=ACRPOT+$P(ACRSSDT,U,4)

 .F I=1:1:5 I $P(ACRDSC,U,I)]"" S ACRPOL=ACRPOL+1

 .F I=1:1:5 I $P(ACRDSC1,U,I)]"" S ACRPOL=ACRPOL+1

 .S ACRPOL=ACRPOL+ACRADSC

 S ACRPOTOT=ACRPOTOT-$P($G(^ACRDOC(ACRDOCDA,13)),U,8)

 S ACRPOT=ACRPOT-$P($G(^ACRDOC(ACRDOCDA,13)),U,8)

 S:'ACRPOT ACRPOT=ACRPOTOT

 S ACRPOL=ACRPOL+2

 I $E($P(^ACRDOC(ACRDOCDA,0),U,3),5,7)>600 S ACRPOL=ACRPOL+2

 S:ACRPOL>5 ACRPOPG=ACRPOPG+1+(ACRPOL\(IOSL-$S($E($G(IOST),1,2)="P-":13,1:5)))

 Q

ACRFSSPO  ;IHS/OIRM/DSD/THL,AEF - REVIEW ITEMS FOR PO PRINT; [ 11/01/2001   9:44 AM ]

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

 +2       ;;ROUTINE TO REVIEW ITEMS FOR PO PRINT

EN         DO EN1

EXIT       KILL ACR,ACRDSC,ACRDSC1,ACRADSC

 +1        QUIT 

EN1        SET (ACR,ACRJ,ACRPOT,ACRPOTOT,ACRPOL,ACRPOL1)=0

 +1        SET (ACRPOPG,ACRDC)=1

 +2        FOR 

               SET ACR=$ORDER(^ACRSS("J",ACRDOCDA,ACR))

               IF 'ACR

                   QUIT 

               Begin DoDot:1

 +3                IF '$DATA(^ACRSS(ACR,0))!'$DATA(^ACRSS(ACR,"DT"))

                       QUIT 

 +4                SET ACRSSDT=^ACRSS(ACR,"DT")

 +5                SET ACRJ=ACRJ+1

 +6                SET ACRDSC=$GET(^ACRSS(ACR,"DESC"))

 +7                SET ACRDSC1=$GET(^ACRSS(ACR,"NOTES"))

 +8                SET ACRADSC=$PIECE($GET(^ACRSS(ACR,1,0)),U,3)

 +9                SET ACRNMS=$GET(^ACRSS(ACR,"NMS"))

 +10               IF $PIECE(ACRNMS,U)]""!($PIECE(ACRNMS,U,2)]"")

                       SET ACRPOL=ACRPOL+1

 +11               SET ACRPOTOT=ACRPOTOT+$PIECE(ACRSSDT,U,9)

 +12               SET ACRPOT=ACRPOT+$PIECE(ACRSSDT,U,4)

 +13               FOR I=1:1:5

                       IF $PIECE(ACRDSC,U,I)]""

                           SET ACRPOL=ACRPOL+1

 +14               FOR I=1:1:5

                       IF $PIECE(ACRDSC1,U,I)]""

                           SET ACRPOL=ACRPOL+1

 +15               SET ACRPOL=ACRPOL+ACRADSC

               End DoDot:1

 +16       SET ACRPOTOT=ACRPOTOT-$PIECE($GET(^ACRDOC(ACRDOCDA,13)),U,8)

 +17       SET ACRPOT=ACRPOT-$PIECE($GET(^ACRDOC(ACRDOCDA,13)),U,8)

 +18       IF 'ACRPOT

               SET ACRPOT=ACRPOTOT

 +19       SET ACRPOL=ACRPOL+2

 +20       IF $EXTRACT($PIECE(^ACRDOC(ACRDOCDA,0),U,3),5,7)>600

               SET ACRPOL=ACRPOL+2

 +21       IF ACRPOL>5

               SET ACRPOPG=ACRPOPG+1+(ACRPOL\(IOSL-$SELECT($EXTRACT($GET(IOST),1,2)="P-":13,1:5)))

 +22       QUIT