ACRF21PS.m

ACRF21PS ;IHS/OIRM/DSD/AEF - ARMS PATCH 21 POST INSTALL ROUTINE [ 01/13/2006  11:08 AM ]

 ;;2.1;ADMINISTRATIVE RESOURCE MGMT SYSTEM;**21**;MAY 27, 2004

 ;

EN ;EP -- MAIN ENTRY POINT -- ACR*2.1*21

 ;

 D ^XBKVAR

 D HOME^%ZIS

 D COMPP

 D CIS56                       ; ADDED 1/13/2006 - EFG

 Q

COMPP ;----- RECOMPILE PRINT TEMPLATES

 ;

 N ACRPTEMP,I,X

 ;

 D BMES^XPDUTL("Recompiling print templates...")

 ;

 F I=1:1 S X=$T(PTEMP+I) Q:X["$$END"  S ACRPTEMP($P(X,";;",2))=""

 ;

 S ACRPTEMP=""

 F  S ACRPTEMP=$O(ACRPTEMP(ACRPTEMP)) Q:ACRPTEMP']""  D

 . D ONEP(ACRPTEMP)

 Q

ONEP(ACRPTEMP)     ;

 ;----- RECOMPILE ONE PRINT TEMPLATE

 ;

 ;      ACRPTEMP  =  PRINT TEMPLATE NAME

 ;

 N ACRFILE,ACRIEN,DMAX,X,Y

 ;

 S ACRFILE=$P(ACRPTEMP,U,2)

 S ACRPTEMP=$P(ACRPTEMP,U)

 S ACRIEN=0

 F  S ACRIEN=$O(^DIPT("B",ACRPTEMP,ACRIEN)) Q:'ACRIEN  D

 . Q:$P($G(^DIPT(ACRIEN,0)),U,4)'=ACRFILE

 . S X=$P($G(^DIPT(ACRIEN,"ROU")),U,2)

 . Q:X']""

 . S Y=ACRIEN

 . S DMAX=$$ROUSIZE^DILF

 . D EN^DIPZ

 Q

CIS56 ; THIS CONVERSION IS NECESSARY FOR THE DCIS PROJECT.

 ; IT IS ELEMENT 11B - SUBCONTRACTING PLAN

 ; IT WILL CONVERT FIELD 56 (SUBCONTRACTING PLAN REQ)

 ;    IN THE CIS CONTRACTS AND GRANTS FILE.

 ;    IF FIELD 56=1 (PLAN REQUIRED) CONVERT TO C

 ;    IF FIELD 56=2 (PLAN NOT REQUIRED) CONVERT TO B

 S ACRCGIEN=0

 F  S ACRCGIEN=$O(^ACGS(ACRCGIEN)) Q:'ACRCGIEN  D

 .Q:'$G(^ACGS(ACRCGIEN,"DT3"))

 .I $P($G(^ACGS(ACRCGIEN,"DT3")),U)'=1,$P($G(^ACGS(ACRCGIEN,"DT3")),U)'=2 Q

 .I $P($G(^ACGS(ACRCGIEN,"DT3")),U)=1 D

 ..S $P(^ACGS(ACRCGIEN,"DT3"),U)="C"

 ..;W !,ACRCGIEN," :  ",$P($G(^ACGS(ACRCGIEN,"DT3")),U)

 .;I $P($G(^ACGS(ACRCGIEN,"DT3")),U)=2 D

 .;S $P(^ACGS(ACRCGIEN,"DT3"),1)="B"

 K ACRCGIEN

 Q

 ; 

PTEMP ;----- PRINT TEMPLATES TO BE COMPILED

 ;;ACR TRAVEL ORDER^9002196

 ;;ACR ORDER FOR SUP HEAD^9002196

 ;;ACR PROGRAM INFO^9999999.62

 ;;ACR PURCHASE ORDER AMENDMENT^9002196

 ;;ACR PURCHASE ORDER INFO^9002196

 ;;ACR ARMS USER ADDRESS^9002185.3

 ;;ACR REQUISITION-TX^9002196

 ;;ACR SEPARATE TRAVEL ITINERARY^9002196

 ;;ACR TRAINING EVALUATION^9002191.6

 ;;ACR TRAVEL ITINERARY^9002196

 ;;ACR TRAVEL ORDER SUMMARY^9002196

 ;;ACR TRAVEL VOUCHER^9002196

 ;;ACR TRAVEL VOUCHER SUMMARY^9002196

 ;;ACR TRAVELER BANK INFO^9002185.3

 ;;ACR ARMS CAN^9002186.5

 ;;ACR DEPARTMENT ACCOUNT INFO^9002188

 ;;ACR CONTROL SEQUENCE INFO^9002190

 ;;ACR SIGNATURE SUMMARY^9002190

 ;;ACR CERTIFICATION^9002197.1

 ;;ACR REQUEST CONTROLLER AUDIT^9002190

 ;;ACR REQUISITION TAIL^9002196

 ;;ACR REQUISITION DISPLAY-2^9002196

 ;;ACR SF-44 DISPLAY^9002196

 ;;ACR TRAVEL ORDER DISPLAY^9002196

 ;;ACR PURCHASE ORDER DISPLAY^9002196

 ;;ACR CONTRACT DISPLAY^9002196

 ;;ACR TRIBAL CONTRACT DISPLAY^9002196

 ;;ACR REQUISITION HEAD^9002196

 ;;ACR REQUISTION-TX SUMMARY^9002196

 ;;ACR SEPARATE TRAVEL ITINERARY^9002196

 ;;ACR TRAVEL VOUCHER AUDIT LIST^9002196

 ;;ACR TRAINING REQUEST DISPLAY^9002196

 ;;ACR PURCHASING OFFICE^9002199.4

 ;;$$END

ACRF21PS  ;IHS/OIRM/DSD/AEF - ARMS PATCH 21 POST INSTALL ROUTINE [ 01/13/2006  11:08 AM ]

 +1       ;;2.1;ADMINISTRATIVE RESOURCE MGMT SYSTEM;**21**;MAY 27, 2004

 +2       ;

EN        ;EP -- MAIN ENTRY POINT -- ACR*2.1*21

 +1       ;

 +2        DO ^XBKVAR

 +3        DO HOME^%ZIS

 +4        DO COMPP

 +5       ; ADDED 1/13/2006 - EFG

           DO CIS56

 +6        QUIT 

COMPP     ;----- RECOMPILE PRINT TEMPLATES

 +1       ;

 +2        NEW ACRPTEMP,I,X

 +3       ;

 +4        DO BMES^XPDUTL("Recompiling print templates...")

 +5       ;

 +6        FOR I=1:1

               SET X=$TEXT(PTEMP+I)

               IF X["$$END"

                   QUIT 

               SET ACRPTEMP($PIECE(X,";;",2))=""

 +7       ;

 +8        SET ACRPTEMP=""

 +9        FOR 

               SET ACRPTEMP=$ORDER(ACRPTEMP(ACRPTEMP))

               IF ACRPTEMP']""

                   QUIT 

               Begin DoDot:1

 +10               DO ONEP(ACRPTEMP)

               End DoDot:1

 +11       QUIT 

ONEP(ACRPTEMP) ;

 +1       ;----- RECOMPILE ONE PRINT TEMPLATE

 +2       ;

 +3       ;      ACRPTEMP  =  PRINT TEMPLATE NAME

 +4       ;

 +5        NEW ACRFILE,ACRIEN,DMAX,X,Y

 +6       ;

 +7        SET ACRFILE=$PIECE(ACRPTEMP,U,2)

 +8        SET ACRPTEMP=$PIECE(ACRPTEMP,U)

 +9        SET ACRIEN=0

 +10       FOR 

               SET ACRIEN=$ORDER(^DIPT("B",ACRPTEMP,ACRIEN))

               IF 'ACRIEN

                   QUIT 

               Begin DoDot:1

 +11               IF $PIECE($GET(^DIPT(ACRIEN,0)),U,4)'=ACRFILE

                       QUIT 

 +12               SET X=$PIECE($GET(^DIPT(ACRIEN,"ROU")),U,2)

 +13               IF X']""

                       QUIT 

 +14               SET Y=ACRIEN

 +15               SET DMAX=$$ROUSIZE^DILF

 +16               DO EN^DIPZ

               End DoDot:1

 +17       QUIT 

CIS56     ; THIS CONVERSION IS NECESSARY FOR THE DCIS PROJECT.

 +1       ; IT IS ELEMENT 11B - SUBCONTRACTING PLAN

 +2       ; IT WILL CONVERT FIELD 56 (SUBCONTRACTING PLAN REQ)

 +3       ;    IN THE CIS CONTRACTS AND GRANTS FILE.

 +4       ;    IF FIELD 56=1 (PLAN REQUIRED) CONVERT TO C

 +5       ;    IF FIELD 56=2 (PLAN NOT REQUIRED) CONVERT TO B

 +6        SET ACRCGIEN=0

 +7        FOR 

               SET ACRCGIEN=$ORDER(^ACGS(ACRCGIEN))

               IF 'ACRCGIEN

                   QUIT 

               Begin DoDot:1

 +8                IF '$GET(^ACGS(ACRCGIEN,"DT3"))

                       QUIT 

 +9                IF $PIECE($GET(^ACGS(ACRCGIEN,"DT3")),U)'=1

                       IF $PIECE($GET(^ACGS(ACRCGIEN,"DT3")),U)'=2

                           QUIT 

 +10               IF $PIECE($GET(^ACGS(ACRCGIEN,"DT3")),U)=1

                       Begin DoDot:2

 +11                       SET $PIECE(^ACGS(ACRCGIEN,"DT3"),U)="C"

 +12      ;W !,ACRCGIEN," :  ",$P($G(^ACGS(ACRCGIEN,"DT3")),U)

                       End DoDot:2

 +13      ;I $P($G(^ACGS(ACRCGIEN,"DT3")),U)=2 D

 +14      ;S $P(^ACGS(ACRCGIEN,"DT3"),1)="B"

               End DoDot:1

 +15       KILL ACRCGIEN

 +16       QUIT 

 +17      ; 

PTEMP     ;----- PRINT TEMPLATES TO BE COMPILED

 +1       ;;ACR TRAVEL ORDER^9002196

 +2       ;;ACR ORDER FOR SUP HEAD^9002196

 +3       ;;ACR PROGRAM INFO^9999999.62

 +4       ;;ACR PURCHASE ORDER AMENDMENT^9002196

 +5       ;;ACR PURCHASE ORDER INFO^9002196

 +6       ;;ACR ARMS USER ADDRESS^9002185.3

 +7       ;;ACR REQUISITION-TX^9002196

 +8       ;;ACR SEPARATE TRAVEL ITINERARY^9002196

 +9       ;;ACR TRAINING EVALUATION^9002191.6

 +10      ;;ACR TRAVEL ITINERARY^9002196

 +11      ;;ACR TRAVEL ORDER SUMMARY^9002196

 +12      ;;ACR TRAVEL VOUCHER^9002196

 +13      ;;ACR TRAVEL VOUCHER SUMMARY^9002196

 +14      ;;ACR TRAVELER BANK INFO^9002185.3

 +15      ;;ACR ARMS CAN^9002186.5

 +16      ;;ACR DEPARTMENT ACCOUNT INFO^9002188

 +17      ;;ACR CONTROL SEQUENCE INFO^9002190

 +18      ;;ACR SIGNATURE SUMMARY^9002190

 +19      ;;ACR CERTIFICATION^9002197.1

 +20      ;;ACR REQUEST CONTROLLER AUDIT^9002190

 +21      ;;ACR REQUISITION TAIL^9002196

 +22      ;;ACR REQUISITION DISPLAY-2^9002196

 +23      ;;ACR SF-44 DISPLAY^9002196

 +24      ;;ACR TRAVEL ORDER DISPLAY^9002196

 +25      ;;ACR PURCHASE ORDER DISPLAY^9002196

 +26      ;;ACR CONTRACT DISPLAY^9002196

 +27      ;;ACR TRIBAL CONTRACT DISPLAY^9002196

 +28      ;;ACR REQUISITION HEAD^9002196

 +29      ;;ACR REQUISTION-TX SUMMARY^9002196

 +30      ;;ACR SEPARATE TRAVEL ITINERARY^9002196

 +31      ;;ACR TRAVEL VOUCHER AUDIT LIST^9002196

 +32      ;;ACR TRAINING REQUEST DISPLAY^9002196

 +33      ;;ACR PURCHASING OFFICE^9002199.4

 +34      ;;$$END