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 ---[H[J[2J[HPRCO211P 1102 printed Dec 13, 2024@02:11:34 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
