PRCOVRQ ;WISC/DJM/DL/BGJ-IFCAP VRQ ENTRY ROUTINE ; 1/28/98 0900
V ;;5.1;IFCAP;**30**;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
NEW(VEN1,SITE) ;VEN1 = VENDOR INTERNAL ENTRY NUMBER
N %,B,DATE,GECSFMS,FLAGN,FY,I,J,PS,NAME,MO,PAY,PAY1,PRCOVA,PRCOVA3,PRCOVN,PRCOVN3,SEQ,SSNT,ST,TIME,TRANS,VEN,VEND,X,Y
S (I,J)=0 F S I=$O(^PRC(411,I)) Q:I'>0 S J=J+1
I J=1 S I=$O(^PRC(411,0)) Q:I'=SITE
S PS=$O(^PRC(411,"AC","Y",0))
I PS="" W !,"There are "_J_" entries in your IFCAP SITE PARAMETER file.",!,"You need to set one as the PRIMARY STATION." Q
I J>1 S SITE=PS
S FLAGN=$G(^PRC(440.3,VEN1,0))
S PRCOVN=$G(^PRC(440,VEN1,0))
S PRCOVN3=$G(^PRC(440,VEN1,3))
S PAY=$G(^PRC(440,VEN1,7))
I FLAGN]"" D
.S PRCOVA=FLAGN
.S PRCOVA3=$G(^PRC(440.3,VEN1,3))
.S PAY1=$G(^PRC(440.3,VEN1,7))
G:PRCOVN3="" EXIT ;THERE IS NO DATA IN NODE 3 FOR THIS VENDOR--THIS USUALLY WILL NOT HAPPEN. CAN ONLY QUIT WITHOUT CREATING 'VRQ'
;
G:$P(PRCOVN3,U,6)="N" EXIT ;NON-RECURRING VENDOR "N"=ONE-TIME VENDOR--DON'T NEED TO 'ADD'
;
G:$P(PRCOVN3,U,4)]"" EXIT ;FMS VENDOR CODE VENDOR UPDATED--DON'T NEED TO 'ADD' AGAIN
;
G:$P(PRCOVN3,U,9)=""!($P(PRCOVN3,U,8)="") EXIT ;NO TAX ID/SSN OR SSN/TAX ID INDICATOR--DON'T HAVE ALL INFORMATION TO SEND 'VRQ'
;
G:PAY="" EXIT ;DON'T HAVE ANY PAYMENT ADDRESS INFORMATION--DON'T SEND 'VRQ'
;
I FLAGN="" G DOIT ;THIS IS A NEW IFCAP VENDOR ENTRY--SEND IT
I $P(PRCOVN3,U,4)="",$P(PRCOVN3,U,12)="" G DOIT ;THIS ENTRY NEEDS TO BE SENT BECAUSE IT WASEN'T EVER DONE BEFORE
;
I $P(PRCOVN,U)'=$P(PRCOVA,U) G DOIT
I $P(PRCOVN3,U,11)'=$P(PRCOVA3,U,11) G DOIT
I $P(PRCOVN3,U,13)'=$P(PRCOVA3,U,13) G DOIT
I $P(PRCOVN3,U,14)'=$P(PRCOVA3,U,14) G DOIT
I $P(PAY,U,3)'=$P(PAY1,U,3) G DOIT
I $P(PAY,U,4)'=$P(PAY1,U,4) G DOIT
I $P(PAY,U,7)'=$P(PAY1,U,7) G DOIT
I $P(PAY,U,8)'=$P(PAY1,U,8) G DOIT
I $P(PAY,U,9)'=$P(PAY1,U,9) G DOIT
G EXIT ;USER DIDN'T CHANGE ANYTHING USED TO CREAT A VENDOR REQUEST
;
DOIT S DIR("A")="DOES A VRQ NEED TO GO TO AUSTIN (YES/NO)",DIR("B")="NO",DIR(0)="Y" D ^DIR K DIR I $D(DIRUT)!(Y=0) Q
;
K ^PRC(440.3,VEN1)
D NOW^%DTC S DATE=$P(%,"."),DATE=$E(DATE,2,7),TIME=$P(%,".",2)_"000000",TIME=$E(TIME,1,6)
S FY=$E($P(%,"."),2,3),MO=$E($P(%,U),4,5),FY=$E(100+$S(+MO>9:FY+1,1:FY),2,3)
K PRCFLN S X=SITE_"-"_FY_"-"_MO D COUNTER^PRCFACP S SEQ="000"_Y,SEQ=$E(SEQ,$L(SEQ)-3,99),TRANS=SITE_FY_MO_SEQ
Q:$P(PRCOVN3,U,8)=""!($P(PRCOVN3,U,14)="")
S B="VRQ^"_DATE_"^"_TIME_"^"_SITE_"^"_VEN1_"^"_$P(PRCOVN3,U,8)_"^"_$S($P(PRCOVN3,U,5)]"":$P(PRCOVN3,U,5),1:"")
S NAME=$P($G(^PRC(440,VEN1,0)),"^"),NAME=$E(NAME,1,30)
S B=B_"^"_NAME_"^",PAY=$G(^PRC(440,VEN1,7)) Q:PAY=""
Q:$P(PAY,U,3)=""!($P(PAY,U,7)="")!($P(PAY,U,8)="")!($P(PAY,U,9)="")
S B=B_$E($P(PAY,U,3),1,30)_"^"_$S($P(PAY,U,4)]"":$E($P(PAY,U,4),1,30),1:"")_"^"_$E($P(PAY,U,7),1,19)_"^"
S ST=$P(PAY,U,8) Q:ST="" S ST=$E($P($G(^DIC(5,ST,0)),U,2),1,2) Q:ST=""
S B=B_ST_"^"_$TR($P(PAY,U,9),"-")_"^",VEND=$S($P(PRCOVN3,U,11)]"":$P(PRCOVN3,U,11),1:"N")
S SSNT=$S($P(PRCOVN3,U,9)]"":$P(PRCOVN3,U,9),1:"T") S:VEND="N" SSNT=""
S B=B_SSNT_"^"_VEND_"^"_$P(PRCOVN3,U,14)_"^N^A^~"
;
W !,"Creating the FMS VENDOR REQUEST."
S $P(^PRC(440,VEN1,3),U,12)="P"
S DIR(0)="E"
S DIR("A")="Enter RETURN to continue"
D ^DIR
K DIR
W !
;
D CONTROL^GECSUFMS("I",SITE,TRANS,"VR","","","","Vendor Request") ;REQUEST GENERIC CODE SHEET PACKAGE SET UP AN ENTRY IN FILE 2100.1
;
D SETCS^GECSSTAA(GECSFMS("DA"),B) ;ENTER THE 'VRQ' SEGMENT INTO FILE 2100.1 RECORD CREATED IN PREVIOUS CALL
;
D SETSTAT^GECSSTAA(GECSFMS("DA"),"Q") ;TELL GCS PACKAGE WHAT TO DO WITH THIS RECORD--'QUEUE' IT TO SEND THE NEXT TIME ANY FMS TRANSACTIONS ARE SENT TO AUSTIN
;
Q
;
EXIT ;USE THIS EXIT ONLY IF NO VRQ SHOULD BE CREATED
W !,"The system determined that no VRQ needed or could be created."
S DIR(0)="E"
S DIR("A")="Enter RETURN to continue"
D ^DIR
K DIR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCOVRQ 3945 printed Nov 22, 2024@17:22:26 Page 2
PRCOVRQ ;WISC/DJM/DL/BGJ-IFCAP VRQ ENTRY ROUTINE ; 1/28/98 0900
V ;;5.1;IFCAP;**30**;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
NEW(VEN1,SITE) ;VEN1 = VENDOR INTERNAL ENTRY NUMBER
+1 NEW %,B,DATE,GECSFMS,FLAGN,FY,I,J,PS,NAME,MO,PAY,PAY1,PRCOVA,PRCOVA3,PRCOVN,PRCOVN3,SEQ,SSNT,ST,TIME,TRANS,VEN,VEND,X,Y
+2 SET (I,J)=0
FOR
SET I=$ORDER(^PRC(411,I))
if I'>0
QUIT
SET J=J+1
+3 IF J=1
SET I=$ORDER(^PRC(411,0))
if I'=SITE
QUIT
+4 SET PS=$ORDER(^PRC(411,"AC","Y",0))
+5 IF PS=""
WRITE !,"There are "_J_" entries in your IFCAP SITE PARAMETER file.",!,"You need to set one as the PRIMARY STATION."
QUIT
+6 IF J>1
SET SITE=PS
+7 SET FLAGN=$GET(^PRC(440.3,VEN1,0))
+8 SET PRCOVN=$GET(^PRC(440,VEN1,0))
+9 SET PRCOVN3=$GET(^PRC(440,VEN1,3))
+10 SET PAY=$GET(^PRC(440,VEN1,7))
+11 IF FLAGN]""
Begin DoDot:1
+12 SET PRCOVA=FLAGN
+13 SET PRCOVA3=$GET(^PRC(440.3,VEN1,3))
+14 SET PAY1=$GET(^PRC(440.3,VEN1,7))
End DoDot:1
+15 ;THERE IS NO DATA IN NODE 3 FOR THIS VENDOR--THIS USUALLY WILL NOT HAPPEN. CAN ONLY QUIT WITHOUT CREATING 'VRQ'
if PRCOVN3=""
GOTO EXIT
+16 ;
+17 ;NON-RECURRING VENDOR "N"=ONE-TIME VENDOR--DON'T NEED TO 'ADD'
if $PIECE(PRCOVN3,U,6)="N"
GOTO EXIT
+18 ;
+19 ;FMS VENDOR CODE VENDOR UPDATED--DON'T NEED TO 'ADD' AGAIN
if $PIECE(PRCOVN3,U,4)]""
GOTO EXIT
+20 ;
+21 ;NO TAX ID/SSN OR SSN/TAX ID INDICATOR--DON'T HAVE ALL INFORMATION TO SEND 'VRQ'
if $PIECE(PRCOVN3,U,9)=""!($PIECE(PRCOVN3,U,8)="")
GOTO EXIT
+22 ;
+23 ;DON'T HAVE ANY PAYMENT ADDRESS INFORMATION--DON'T SEND 'VRQ'
if PAY=""
GOTO EXIT
+24 ;
+25 ;THIS IS A NEW IFCAP VENDOR ENTRY--SEND IT
IF FLAGN=""
GOTO DOIT
+26 ;THIS ENTRY NEEDS TO BE SENT BECAUSE IT WASEN'T EVER DONE BEFORE
IF $PIECE(PRCOVN3,U,4)=""
IF $PIECE(PRCOVN3,U,12)=""
GOTO DOIT
+27 ;
+28 IF $PIECE(PRCOVN,U)'=$PIECE(PRCOVA,U)
GOTO DOIT
+29 IF $PIECE(PRCOVN3,U,11)'=$PIECE(PRCOVA3,U,11)
GOTO DOIT
+30 IF $PIECE(PRCOVN3,U,13)'=$PIECE(PRCOVA3,U,13)
GOTO DOIT
+31 IF $PIECE(PRCOVN3,U,14)'=$PIECE(PRCOVA3,U,14)
GOTO DOIT
+32 IF $PIECE(PAY,U,3)'=$PIECE(PAY1,U,3)
GOTO DOIT
+33 IF $PIECE(PAY,U,4)'=$PIECE(PAY1,U,4)
GOTO DOIT
+34 IF $PIECE(PAY,U,7)'=$PIECE(PAY1,U,7)
GOTO DOIT
+35 IF $PIECE(PAY,U,8)'=$PIECE(PAY1,U,8)
GOTO DOIT
+36 IF $PIECE(PAY,U,9)'=$PIECE(PAY1,U,9)
GOTO DOIT
+37 ;USER DIDN'T CHANGE ANYTHING USED TO CREAT A VENDOR REQUEST
GOTO EXIT
+38 ;
DOIT SET DIR("A")="DOES A VRQ NEED TO GO TO AUSTIN (YES/NO)"
SET DIR("B")="NO"
SET DIR(0)="Y"
DO ^DIR
KILL DIR
IF $DATA(DIRUT)!(Y=0)
QUIT
+1 ;
+2 KILL ^PRC(440.3,VEN1)
+3 DO NOW^%DTC
SET DATE=$PIECE(%,".")
SET DATE=$EXTRACT(DATE,2,7)
SET TIME=$PIECE(%,".",2)_"000000"
SET TIME=$EXTRACT(TIME,1,6)
+4 SET FY=$EXTRACT($PIECE(%,"."),2,3)
SET MO=$EXTRACT($PIECE(%,U),4,5)
SET FY=$EXTRACT(100+$SELECT(+MO>9:FY+1,1:FY),2,3)
+5 KILL PRCFLN
SET X=SITE_"-"_FY_"-"_MO
DO COUNTER^PRCFACP
SET SEQ="000"_Y
SET SEQ=$EXTRACT(SEQ,$LENGTH(SEQ)-3,99)
SET TRANS=SITE_FY_MO_SEQ
+6 if $PIECE(PRCOVN3,U,8)=""!($PIECE(PRCOVN3,U,14)="")
QUIT
+7 SET B="VRQ^"_DATE_"^"_TIME_"^"_SITE_"^"_VEN1_"^"_$PIECE(PRCOVN3,U,8)_"^"_$SELECT($PIECE(PRCOVN3,U,5)]"":$PIECE(PRCOVN3,U,5),1:"")
+8 SET NAME=$PIECE($GET(^PRC(440,VEN1,0)),"^")
SET NAME=$EXTRACT(NAME,1,30)
+9 SET B=B_"^"_NAME_"^"
SET PAY=$GET(^PRC(440,VEN1,7))
if PAY=""
QUIT
+10 if $PIECE(PAY,U,3)=""!($PIECE(PAY,U,7)="")!($PIECE(PAY,U,8)="")!($PIECE(PAY,U,9)="")
QUIT
+11 SET B=B_$EXTRACT($PIECE(PAY,U,3),1,30)_"^"_$SELECT($PIECE(PAY,U,4)]"":$EXTRACT($PIECE(PAY,U,4),1,30),1:"")_"^"_$EXTRACT($PIECE(PAY,U,7),1,19)_"^"
+12 SET ST=$PIECE(PAY,U,8)
if ST=""
QUIT
SET ST=$EXTRACT($PIECE($GET(^DIC(5,ST,0)),U,2),1,2)
if ST=""
QUIT
+13 SET B=B_ST_"^"_$TRANSLATE($PIECE(PAY,U,9),"-")_"^"
SET VEND=$SELECT($PIECE(PRCOVN3,U,11)]"":$PIECE(PRCOVN3,U,11),1:"N")
+14 SET SSNT=$SELECT($PIECE(PRCOVN3,U,9)]"":$PIECE(PRCOVN3,U,9),1:"T")
if VEND="N"
SET SSNT=""
+15 SET B=B_SSNT_"^"_VEND_"^"_$PIECE(PRCOVN3,U,14)_"^N^A^~"
+16 ;
+17 WRITE !,"Creating the FMS VENDOR REQUEST."
+18 SET $PIECE(^PRC(440,VEN1,3),U,12)="P"
+19 SET DIR(0)="E"
+20 SET DIR("A")="Enter RETURN to continue"
+21 DO ^DIR
+22 KILL DIR
+23 WRITE !
+24 ;
+25 ;REQUEST GENERIC CODE SHEET PACKAGE SET UP AN ENTRY IN FILE 2100.1
DO CONTROL^GECSUFMS("I",SITE,TRANS,"VR","","","","Vendor Request")
+26 ;
+27 ;ENTER THE 'VRQ' SEGMENT INTO FILE 2100.1 RECORD CREATED IN PREVIOUS CALL
DO SETCS^GECSSTAA(GECSFMS("DA"),B)
+28 ;
+29 ;TELL GCS PACKAGE WHAT TO DO WITH THIS RECORD--'QUEUE' IT TO SEND THE NEXT TIME ANY FMS TRANSACTIONS ARE SENT TO AUSTIN
DO SETSTAT^GECSSTAA(GECSFMS("DA"),"Q")
+30 ;
+31 QUIT
+32 ;
EXIT ;USE THIS EXIT ONLY IF NO VRQ SHOULD BE CREATED
+1 WRITE !,"The system determined that no VRQ needed or could be created."
+2 SET DIR(0)="E"
+3 SET DIR("A")="Enter RETURN to continue"
+4 DO ^DIR
+5 KILL DIR
+6 QUIT
