PRCOVTST ;WISC/DJM/BGJ-IFCAP VRQ TO-DO ROUTINE ; [10/19/98 11:20am]
V ;;5.1;IFCAP;**30**;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
NEW(VEN1,SITE,FLAG) ;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 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'
;
I FLAG=1,$P(PRCOVN3,U,4)]"" G EXIT ;'ADD' VRQ & FMS VENDOR CODE??? VENDOR UPDATED--DON'T NEED TO 'ADD' AGAIN (SHOULD NOT SEE THIS)
;
I FLAG=1,(($P(PRCOVN3,U,9)="")!($P(PRCOVN3,U,8)="")) G 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 FLAG=1,$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 ;COME HERE IF A VRQ SHOULD BE CREATED.
S NOVRQ=0
Q NOVRQ
;
EXIT ;USE THIS EXIT ONLY IF NO VRQ SHOULD BE CREATED.
;DON'T FORGET TO REMOVE UN-EDITED COPY OF VENDOR RECORD (IN 440.3).
K ^PRC(440.3,VEN1)
S NOVRQ=1
Q NOVRQ
;
CHECK(DA,SITE,FLAG) ; CALL TO SEE IF VENDOR IS PROPERLY SET UP FROM AR
; VENDOR LOOKUP CALL -- VENSEL^PRCHUTL().
; COME HERE TO DECIDE WHAT NEEDS TO BE DONE WITH THE SELECTED
; VENDOR.
;
; RETURNED VALUE MEANING
; 0 NEED TO CREATE A VRQ - ALL DATA TO
; CREATE A VRQ IS HERE.
; 1 NEED TO EDIT VENDOR RECORD BEFORE A
; VRQ CAN BE CREATED.
; 2 THE VENDOR IS PROPERLY SET UP. NO
; VRQ NEEDS TO BE CREATED.
;
S PRCOVN3=$G(^PRC(440,DA,3))
I FLAG=1,$P(PRCOVN3,U,4)]"" G EXIT2 ;ADD VRQ WITH FMS VENDOR CODE
; PRESENT??? VENDOR UPDATED--DON'T NEED TO 'ADD' AGAIN.
;
S (I,J)=0
F S I=$O(^PRC(411,I)) Q:I'>0 S J=J+1
I J>1 S PS=$O(^PRC(411,"AC","Y",0)) G:PS="" EXIT1
; 'PRIMARY STATION' NEEDS TO BE FILLED IN.
;
S PAY=$G(^PRC(440,DA,7))
G:PRCOVN3="" EXIT1 ; THIS RECORD NEEDS TO BE EDITED.
;
G:$P(PRCOVN3,U,6)="N" EXIT1 ; NON-RECURRING VENDOR THIS RECORD
; NEEDS TO BE EDITED.
;
G:$P(PRCOVN3,U,14)="" EXIT1 ; VENDOR TYPE UNDEFINED.
G:PAY="" EXIT1
; DON'T HAVE ANY PAYMENT ADDRESS INFORMATION--EDIT THIS RECORD.
;
G:$P(PAY,U,3)=""!($P(PAY,U,7)="")!($P(PAY,U,8)="")!($P(PAY,U,9)="") EXIT1 ; PAYMENT FIELDS AREN'T FILLED IN.
S ST=$P(PAY,U,8)
S ST=$E($P($G(^DIC(5,ST,0)),U,2),1,2)
G:ST="" EXIT1 ; FOR SOME REASON THIS STATE IS MISSING FROM THE
; STATE FILE.
;
I FLAG=1,(($P(PRCOVN3,U,9)="")!($P(PRCOVN3,U,8)="")) G EXIT1
; NO TAX ID/SSN OR SSN/TAX ID INDICATOR--DON'T HAVE ALL INFORMATION
; TO SEND 'VRQ'. EDIT THIS RECORD.
;
DOIT1 ; COME HERE IF A VRQ SHOULD BE CREATED.
S NOVRQ=0
Q NOVRQ
;
EXIT1 ; COME HERE IF THE VENDOR RECORD NEEDS TO BE EDITED.
S NOVRQ=1
Q NOVRQ
;
EXIT2 ; USE THIS EXIT ONLY IF NO VRQ SHOULD BE CREATED.
; IF THERE IS NO "AR" NODE PRESENT REMOVE UN-EDITED COPY OF VENDOR
; RECORD (IN 440.3).
S NODE=$D(^PRC(440.3,DA,"AR"))
I NODE]"" S NODE=1
K:NODE=0 ^PRC(440.3,DA)
S NOVRQ=2
Q NOVRQ
;
VRQ(DA,SITE) ; COME HERE TO SEND A VRQ FOR THE VENDOR RECORD SELECTED
; BY THE AR USER. THIS ENTRY POINT IS CALLED FROM VENSEL^PRCHUTL().
S PRCXDA=DA
K ^PRC(440.3,DA)
VRQ1 S PRCOVN3=$G(^PRC(440,DA,3))
D NOW^%DTC
S DATE=$P(%,".")
S DATE=$E(DATE,2,7)
S TIME=$P(%,".",2)_"000000"
S TIME=$E(TIME,1,6)
S FY=$E($P(%,"."),2,3)
S MO=$E($P(%,U),4,5)
S 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
S SEQ=$E(SEQ,$L(SEQ)-3,99)
S TRANS=SITE_FY_MO_SEQ
S DA=PRCXDA
S B="VRQ^"_DATE_"^"_TIME_"^"_SITE_"^"_DA_"^"_$P(PRCOVN3,U,8)_"^"
S B=B_$S($P(PRCOVN3,U,5)]"":$P(PRCOVN3,U,5),1:"")
S NAME=$P($G(^PRC(440,DA,0)),"^")
S NAME=$E(NAME,1,30)
S B=B_"^"_NAME_"^"
S PAY=$G(^PRC(440,DA,7))
S B=B_$E($P(PAY,U,3),1,30)_"^"
S B=B_$S($P(PAY,U,4)]"":$E($P(PAY,U,4),1,30),1:"")_"^"
S B=B_$E($P(PAY,U,7),1,19)_"^"
S ST=$P(PAY,U,8)
S ST=$E($P($G(^DIC(5,ST,0)),U,2),1,2)
S B=B_ST_"^"_$TR($P(PAY,U,9),"-")_"^"
S 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^~"
;
; REQUEST GENERIC CODE SHEET PACKAGE SET UP AN ENTRY IN FILE 2100.1.
;
D CONTROL^GECSUFMS("I",SITE,TRANS,"VR","","","","Vendor Request")
;
; ENTER THE 'VRQ' SEGMENT INTO FILE 2100.1 RECORD CREATED IN
; PREVIOUS CALL.
;
D SETCS^GECSSTAA(GECSFMS("DA"),B)
;
; TELL GCS PACKAGE WHAT TO DO WITH THIS RECORD--'QUEUE' IT TO SEND
; THE NEXT TIME ANY FMS TRANSACTIONS ARE SENT TO AUSTIN.
;
Q
;
VRQS(DA,SITE) ; COME HERE TO SEND A VRQ FROM THE 'SEND VRQ' PROTOCOL.
;
S PRCXDA=DA
;
; NOW LETS GO OVER TO SEND THIS VRQ TO AUSTIN, WITHOUT KILLING THE
; RECORD IN FILE 440.3. THAT RECORD IS USED WITHIN THE AR EDIT
; LIST TEMPLATE UNTIL 'DELETE EDIT REQUEST' REMOVES THE RECORD.
;
G VRQ1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCOVTST 6017 printed Oct 16, 2024@18:13:08 Page 2
PRCOVTST ;WISC/DJM/BGJ-IFCAP VRQ TO-DO ROUTINE ; [10/19/98 11:20am]
V ;;5.1;IFCAP;**30**;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
NEW(VEN1,SITE,FLAG) ;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 FLAGN=$GET(^PRC(440.3,VEN1,0))
+3 SET PRCOVN=$GET(^PRC(440,VEN1,0))
+4 SET PRCOVN3=$GET(^PRC(440,VEN1,3))
+5 SET PAY=$GET(^PRC(440,VEN1,7))
+6 IF FLAGN]""
Begin DoDot:1
+7 SET PRCOVA=FLAGN
+8 SET PRCOVA3=$GET(^PRC(440.3,VEN1,3))
+9 SET PAY1=$GET(^PRC(440.3,VEN1,7))
End DoDot:1
+10 ;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
+11 ;
+12 ;NON-RECURRING VENDOR "N"=ONE-TIME VENDOR--DON'T NEED TO 'ADD'
if $PIECE(PRCOVN3,U,6)="N"
GOTO EXIT
+13 ;
+14 ;'ADD' VRQ & FMS VENDOR CODE??? VENDOR UPDATED--DON'T NEED TO 'ADD' AGAIN (SHOULD NOT SEE THIS)
IF FLAG=1
IF $PIECE(PRCOVN3,U,4)]""
GOTO EXIT
+15 ;
+16 ;NO TAX ID/SSN OR SSN/TAX ID INDICATOR--DON'T HAVE ALL INFORMATION TO SEND 'VRQ'
IF FLAG=1
IF (($PIECE(PRCOVN3,U,9)="")!($PIECE(PRCOVN3,U,8)=""))
GOTO EXIT
+17 ;
+18 ;DON'T HAVE ANY PAYMENT ADDRESS INFORMATION--DON'T SEND 'VRQ'
if PAY=""
GOTO EXIT
+19 ;
+20 ;THIS IS A NEW IFCAP VENDOR ENTRY--SEND IT
IF FLAGN=""
GOTO DOIT
+21 ;THIS ENTRY NEEDS TO BE SENT BECAUSE IT WASEN'T EVER DONE BEFORE
IF FLAG=1
IF $PIECE(PRCOVN3,U,4)=""
IF $PIECE(PRCOVN3,U,12)=""
GOTO DOIT
+22 ;
+23 IF $PIECE(PRCOVN,U)'=$PIECE(PRCOVA,U)
GOTO DOIT
+24 IF $PIECE(PRCOVN3,U,11)'=$PIECE(PRCOVA3,U,11)
GOTO DOIT
+25 IF $PIECE(PRCOVN3,U,13)'=$PIECE(PRCOVA3,U,13)
GOTO DOIT
+26 IF $PIECE(PRCOVN3,U,14)'=$PIECE(PRCOVA3,U,14)
GOTO DOIT
+27 IF $PIECE(PAY,U,3)'=$PIECE(PAY1,U,3)
GOTO DOIT
+28 IF $PIECE(PAY,U,4)'=$PIECE(PAY1,U,4)
GOTO DOIT
+29 IF $PIECE(PAY,U,7)'=$PIECE(PAY1,U,7)
GOTO DOIT
+30 IF $PIECE(PAY,U,8)'=$PIECE(PAY1,U,8)
GOTO DOIT
+31 IF $PIECE(PAY,U,9)'=$PIECE(PAY1,U,9)
GOTO DOIT
+32 ;USER DIDN'T CHANGE ANYTHING USED TO CREAT A VENDOR REQUEST
GOTO EXIT
+33 ;
DOIT ;COME HERE IF A VRQ SHOULD BE CREATED.
+1 SET NOVRQ=0
+2 QUIT NOVRQ
+3 ;
EXIT ;USE THIS EXIT ONLY IF NO VRQ SHOULD BE CREATED.
+1 ;DON'T FORGET TO REMOVE UN-EDITED COPY OF VENDOR RECORD (IN 440.3).
+2 KILL ^PRC(440.3,VEN1)
+3 SET NOVRQ=1
+4 QUIT NOVRQ
+5 ;
CHECK(DA,SITE,FLAG) ; CALL TO SEE IF VENDOR IS PROPERLY SET UP FROM AR
+1 ; VENDOR LOOKUP CALL -- VENSEL^PRCHUTL().
+2 ; COME HERE TO DECIDE WHAT NEEDS TO BE DONE WITH THE SELECTED
+3 ; VENDOR.
+4 ;
+5 ; RETURNED VALUE MEANING
+6 ; 0 NEED TO CREATE A VRQ - ALL DATA TO
+7 ; CREATE A VRQ IS HERE.
+8 ; 1 NEED TO EDIT VENDOR RECORD BEFORE A
+9 ; VRQ CAN BE CREATED.
+10 ; 2 THE VENDOR IS PROPERLY SET UP. NO
+11 ; VRQ NEEDS TO BE CREATED.
+12 ;
+13 SET PRCOVN3=$GET(^PRC(440,DA,3))
+14 ;ADD VRQ WITH FMS VENDOR CODE
IF FLAG=1
IF $PIECE(PRCOVN3,U,4)]""
GOTO EXIT2
+15 ; PRESENT??? VENDOR UPDATED--DON'T NEED TO 'ADD' AGAIN.
+16 ;
+17 SET (I,J)=0
+18 FOR
SET I=$ORDER(^PRC(411,I))
if I'>0
QUIT
SET J=J+1
+19 IF J>1
SET PS=$ORDER(^PRC(411,"AC","Y",0))
if PS=""
GOTO EXIT1
+20 ; 'PRIMARY STATION' NEEDS TO BE FILLED IN.
+21 ;
+22 SET PAY=$GET(^PRC(440,DA,7))
+23 ; THIS RECORD NEEDS TO BE EDITED.
if PRCOVN3=""
GOTO EXIT1
+24 ;
+25 ; NON-RECURRING VENDOR THIS RECORD
if $PIECE(PRCOVN3,U,6)="N"
GOTO EXIT1
+26 ; NEEDS TO BE EDITED.
+27 ;
+28 ; VENDOR TYPE UNDEFINED.
if $PIECE(PRCOVN3,U,14)=""
GOTO EXIT1
+29 if PAY=""
GOTO EXIT1
+30 ; DON'T HAVE ANY PAYMENT ADDRESS INFORMATION--EDIT THIS RECORD.
+31 ;
+32 ; PAYMENT FIELDS AREN'T FILLED IN.
if $PIECE(PAY,U,3)=""!($PIECE(PAY,U,7)="")!($PIECE(PAY,U,8)="")!($PIECE(PAY,U,9)="")
GOTO EXIT1
+33 SET ST=$PIECE(PAY,U,8)
+34 SET ST=$EXTRACT($PIECE($GET(^DIC(5,ST,0)),U,2),1,2)
+35 ; FOR SOME REASON THIS STATE IS MISSING FROM THE
if ST=""
GOTO EXIT1
+36 ; STATE FILE.
+37 ;
+38 IF FLAG=1
IF (($PIECE(PRCOVN3,U,9)="")!($PIECE(PRCOVN3,U,8)=""))
GOTO EXIT1
+39 ; NO TAX ID/SSN OR SSN/TAX ID INDICATOR--DON'T HAVE ALL INFORMATION
+40 ; TO SEND 'VRQ'. EDIT THIS RECORD.
+41 ;
DOIT1 ; COME HERE IF A VRQ SHOULD BE CREATED.
+1 SET NOVRQ=0
+2 QUIT NOVRQ
+3 ;
EXIT1 ; COME HERE IF THE VENDOR RECORD NEEDS TO BE EDITED.
+1 SET NOVRQ=1
+2 QUIT NOVRQ
+3 ;
EXIT2 ; USE THIS EXIT ONLY IF NO VRQ SHOULD BE CREATED.
+1 ; IF THERE IS NO "AR" NODE PRESENT REMOVE UN-EDITED COPY OF VENDOR
+2 ; RECORD (IN 440.3).
+3 SET NODE=$DATA(^PRC(440.3,DA,"AR"))
+4 IF NODE]""
SET NODE=1
+5 if NODE=0
KILL ^PRC(440.3,DA)
+6 SET NOVRQ=2
+7 QUIT NOVRQ
+8 ;
VRQ(DA,SITE) ; COME HERE TO SEND A VRQ FOR THE VENDOR RECORD SELECTED
+1 ; BY THE AR USER. THIS ENTRY POINT IS CALLED FROM VENSEL^PRCHUTL().
+2 SET PRCXDA=DA
+3 KILL ^PRC(440.3,DA)
VRQ1 SET PRCOVN3=$GET(^PRC(440,DA,3))
+1 DO NOW^%DTC
+2 SET DATE=$PIECE(%,".")
+3 SET DATE=$EXTRACT(DATE,2,7)
+4 SET TIME=$PIECE(%,".",2)_"000000"
+5 SET TIME=$EXTRACT(TIME,1,6)
+6 SET FY=$EXTRACT($PIECE(%,"."),2,3)
+7 SET MO=$EXTRACT($PIECE(%,U),4,5)
+8 SET FY=$EXTRACT(100+$SELECT(+MO>9:FY+1,1:FY),2,3)
+9 KILL PRCFLN
+10 SET X=SITE_"-"_FY_"-"_MO
+11 DO COUNTER^PRCFACP
+12 SET SEQ="000"_Y
+13 SET SEQ=$EXTRACT(SEQ,$LENGTH(SEQ)-3,99)
+14 SET TRANS=SITE_FY_MO_SEQ
+15 SET DA=PRCXDA
+16 SET B="VRQ^"_DATE_"^"_TIME_"^"_SITE_"^"_DA_"^"_$PIECE(PRCOVN3,U,8)_"^"
+17 SET B=B_$SELECT($PIECE(PRCOVN3,U,5)]"":$PIECE(PRCOVN3,U,5),1:"")
+18 SET NAME=$PIECE($GET(^PRC(440,DA,0)),"^")
+19 SET NAME=$EXTRACT(NAME,1,30)
+20 SET B=B_"^"_NAME_"^"
+21 SET PAY=$GET(^PRC(440,DA,7))
+22 SET B=B_$EXTRACT($PIECE(PAY,U,3),1,30)_"^"
+23 SET B=B_$SELECT($PIECE(PAY,U,4)]"":$EXTRACT($PIECE(PAY,U,4),1,30),1:"")_"^"
+24 SET B=B_$EXTRACT($PIECE(PAY,U,7),1,19)_"^"
+25 SET ST=$PIECE(PAY,U,8)
+26 SET ST=$EXTRACT($PIECE($GET(^DIC(5,ST,0)),U,2),1,2)
+27 SET B=B_ST_"^"_$TRANSLATE($PIECE(PAY,U,9),"-")_"^"
+28 SET VEND=$SELECT($PIECE(PRCOVN3,U,11)]"":$PIECE(PRCOVN3,U,11),1:"N")
+29 SET SSNT=$SELECT($PIECE(PRCOVN3,U,9)]"":$PIECE(PRCOVN3,U,9),1:"T")
+30 if VEND="N"
SET SSNT=""
+31 SET B=B_SSNT_"^"_VEND_"^"_$PIECE(PRCOVN3,U,14)_"^N^A^~"
+32 ;
+33 ; REQUEST GENERIC CODE SHEET PACKAGE SET UP AN ENTRY IN FILE 2100.1.
+34 ;
+35 DO CONTROL^GECSUFMS("I",SITE,TRANS,"VR","","","","Vendor Request")
+36 ;
+37 ; ENTER THE 'VRQ' SEGMENT INTO FILE 2100.1 RECORD CREATED IN
+38 ; PREVIOUS CALL.
+39 ;
+40 DO SETCS^GECSSTAA(GECSFMS("DA"),B)
+41 ;
+42 ; TELL GCS PACKAGE WHAT TO DO WITH THIS RECORD--'QUEUE' IT TO SEND
+43 ; THE NEXT TIME ANY FMS TRANSACTIONS ARE SENT TO AUSTIN.
+44 ;
+45 QUIT
+46 ;
VRQS(DA,SITE) ; COME HERE TO SEND A VRQ FROM THE 'SEND VRQ' PROTOCOL.
+1 ;
+2 SET PRCXDA=DA
+3 ;
+4 ; NOW LETS GO OVER TO SEND THIS VRQ TO AUSTIN, WITHOUT KILLING THE
+5 ; RECORD IN FILE 440.3. THAT RECORD IS USED WITHIN THE AR EDIT
+6 ; LIST TEMPLATE UNTIL 'DELETE EDIT REQUEST' REMOVES THE RECORD.
+7 ;
+8 GOTO VRQ1
