PRCO211P.m

PRCO211P ;MNTVBB/RGB/File 2100.1 Vendor (VR) docs set to (A)ccepted ; 04 Mar 2019

V ;;5.1;IFCAP;**211**;Oct 20, 2000;Build 9

 ;Per VA Directive 6402, this routine should not be modified.

 ;;

 ;PRC*5.1*211 Status update to VR documents found in ^GECS(2100.1

 ;             flipped from 'T'ransmitted to 'A'ccepted

 Q

EN ;VR document status set from (T)ransmitted to (A)ccepted

 S U="^",GECSID="VR-0",GECST=0,GECSTAT="A",DT=$$DT^XLFDT

 K ^XTMP("PRCO211P")

 S ^XTMP("PRCO211P",0)=$$FMADD^XLFDT(DT,90)_"^"_DT,TT=0

 D NOW^%DTC S ^XTMP("PRCO211P",$J,"ZZASTART")=%

1 ;Find/flip all VR docs (vendor updates) from status 'T' to 'A'

 F  S GECSID=$O(^GECS(2100.1,"B",GECSID)),GECSIEN=0 Q:GECSID'["VR"  D

 . F  S GECSIEN=$O(^GECS(2100.1,"B",GECSID,GECSIEN)) Q:'GECSIEN  D

 . . S GECSR0=$G(^GECS(2100.1,GECSIEN,0)) I GECSR0=""!(GECSR0'["VR-") Q

 . . I $P(GECSR0,U,4)="T" D

 . . . S ^XTMP("PRCO211P",$J,GECSIEN,0)=GECSR0,GECST=GECST+1

 . . . S DA=GECSIEN,DIE="^GECS(2100.1,",DR="3///^S X=GECSTAT" D ^DIE

 D NOW^%DTC S ^XTMP("PRCO211P",$J,"ZZBEND")=%

 S ^XTMP("PRCO211P",$J,"ZZTOTALS")=GECST

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---PRCO211P   1102     printed  Apr 09, 2024@21:17:19                                                                                                                                                                                                    Page 2

PRCO211P  ;MNTVBB/RGB/File 2100.1 Vendor (VR) docs set to (A)ccepted ; 04 Mar 2019

V         ;;5.1;IFCAP;**211**;Oct 20, 2000;Build 9

 +1       ;Per VA Directive 6402, this routine should not be modified.

 +2       ;;

 +3       ;PRC*5.1*211 Status update to VR documents found in ^GECS(2100.1

 +4       ;             flipped from 'T'ransmitted to 'A'ccepted

 +5        QUIT 

EN        ;VR document status set from (T)ransmitted to (A)ccepted

 +1        SET U="^"

           SET GECSID="VR-0"

           SET GECST=0

           SET GECSTAT="A"

           SET DT=$$DT^XLFDT

 +2        KILL ^XTMP("PRCO211P")

 +3        SET ^XTMP("PRCO211P",0)=$$FMADD^XLFDT(DT,90)_"^"_DT

           SET TT=0

 +4        DO NOW^%DTC

           SET ^XTMP("PRCO211P",$JOB,"ZZASTART")=%

1         ;Find/flip all VR docs (vendor updates) from status 'T' to 'A'

 +1        FOR 

               SET GECSID=$ORDER(^GECS(2100.1,"B",GECSID))

               SET GECSIEN=0

               if GECSID'["VR"

                   QUIT 

               Begin DoDot:1

 +2                FOR 

                       SET GECSIEN=$ORDER(^GECS(2100.1,"B",GECSID,GECSIEN))

                       if 'GECSIEN

                           QUIT 

                       Begin DoDot:2

 +3                        SET GECSR0=$GET(^GECS(2100.1,GECSIEN,0))

                           IF GECSR0=""!(GECSR0'["VR-")

                               QUIT 

 +4                        IF $PIECE(GECSR0,U,4)="T"

                               Begin DoDot:3

 +5                                SET ^XTMP("PRCO211P",$JOB,GECSIEN,0)=GECSR0

                                   SET GECST=GECST+1

 +6                                SET DA=GECSIEN

                                   SET DIE="^GECS(2100.1,"

                                   SET DR="3///^S X=GECSTAT"

                                   DO ^DIE

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +7        DO NOW^%DTC

           SET ^XTMP("PRCO211P",$JOB,"ZZBEND")=%

 +8        SET ^XTMP("PRCO211P",$JOB,"ZZTOTALS")=GECST

 +9        QUIT