- PRCOVRQ1 ;WISC/DJM/DL/BGJ-IFCAP VRQ CHANGE 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.
- UPDATE(VEN1,SITE) ;VEN1 = VENDOR INTERNAL ENTRY NUMBER
- ;SITE = STATION NUMBER
- N %,B,DATE,FY,GECSFMS,I,J,PS,MO,PAY,PAY1,PRCOVA,PRCOVN,PRCOVA3,PRCOVN3,SEQ,SSNT,ST,TIME,TRANS,VEND,X,Y,NAME
- 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 PRCOVN=$G(^PRC(440,VEN1,0)),PRCOVA=$G(^PRC(440.3,VEN1,0))
- S PRCOVN3=$G(^PRC(440,VEN1,3)),PAY=$G(^PRC(440,VEN1,7))
- S PRCOVA3=$G(^PRC(440.3,VEN1,3)) ;ORGINAL DATA BEFORE EDIT - USE TO SEE IF ENTRY WAS CHANGED
- 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:PAY="" EXIT ;DON'T HAVE ANY PAYMENT ADDRESS INFORMATION--DON'T SEND 'VRQ'
- ;
- I $P(PRCOVN,U)'=$P(PRCOVA,U) G DOIT ;USER CHANGED VENDOR NAME
- I $P(PRCOVN3,U,11)'=$P(PRCOVA3,U,11) G DOIT ;USER CHANGED 1099 VENDOR INDICATOR
- I $P(PRCOVN3,U,13)'=$P(PRCOVA3,U,13) G DOIT ;USER CHANGED CENTERAL REMIT
- I $P(PRCOVN3,U,14)'=$P(PRCOVA3,U,14) G DOIT ;USER CHANGED VENDOR TYPE
- I $P(PAY,U,3)'=$P(PAY1,U,3) G DOIT ;USER CHANGED PAYMENT ADDRESS1
- I $P(PAY,U,4)'=$P(PAY1,U,4) G DOIT ;USER CHANGED PAYMENT ADDRESS2
- I $P(PAY,U,7)'=$P(PAY1,U,7) G DOIT ;USER CHANGED PAYMENT CITY
- I $P(PAY,U,8)'=$P(PAY1,U,8) G DOIT ;USER CHANGED PAYMENT STATE
- I $P(PAY,U,9)'=$P(PAY1,U,9) G DOIT ;USER CHANGED PAYMENT ZIP CODE
- G EXIT ;USER DIDN'T CHANGE ANYTHING NEEDED 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
- S B="VRQ^"_DATE_"^"_TIME_"^"_SITE_"^"_VEN1_"^"_$P(PRCOVN3,U,4)_"^"_$S($P(PRCOVN3,U,5)]"":$P(PRCOVN3,U,5),1:"")
- S NAME=$E($P(PRCOVN,U),1,30)
- S B=B_"^"_NAME_"^"_$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)
- S B=B_ST_"^"_$TR($P(PAY,U,9),"-")_"^"
- S SSNT=$S($P(PRCOVN3,U,9)]"":$P(PRCOVN3,U,9),1:"T")
- S VEND=$S($P(PRCOVN3,U,11)]"":$P(PRCOVN3,U,11),1:"N") S:VEND="N" SSNT=""
- S B=B_SSNT_"^"_VEND_"^"_$P(PRCOVN3,U,14)_"^N^C^~"
- ;
- 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[HPRCOVRQ1 3556 printed Feb 18, 2025@23:38:45 Page 2
- PRCOVRQ1 ;WISC/DJM/DL/BGJ-IFCAP VRQ CHANGE 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.
- UPDATE(VEN1,SITE) ;VEN1 = VENDOR INTERNAL ENTRY NUMBER
- +1 ;SITE = STATION NUMBER
- +2 NEW %,B,DATE,FY,GECSFMS,I,J,PS,MO,PAY,PAY1,PRCOVA,PRCOVN,PRCOVA3,PRCOVN3,SEQ,SSNT,ST,TIME,TRANS,VEND,X,Y,NAME
- +3 SET (I,J)=0
- FOR
- SET I=$ORDER(^PRC(411,I))
- if I'>0
- QUIT
- SET J=J+1
- +4 IF J=1
- SET I=$ORDER(^PRC(411,0))
- if I'=SITE
- QUIT
- +5 SET PS=$ORDER(^PRC(411,"AC","Y",0))
- +6 IF PS=""
- WRITE !,"There are "_J_" entries in your IFCAP SITE PARAMETER file.",!,"You need to set one as the PRIMARY STATION."
- QUIT
- +7 IF J>1
- SET SITE=PS
- +8 SET PRCOVN=$GET(^PRC(440,VEN1,0))
- SET PRCOVA=$GET(^PRC(440.3,VEN1,0))
- +9 SET PRCOVN3=$GET(^PRC(440,VEN1,3))
- SET PAY=$GET(^PRC(440,VEN1,7))
- +10 ;ORGINAL DATA BEFORE EDIT - USE TO SEE IF ENTRY WAS CHANGED
- SET PRCOVA3=$GET(^PRC(440.3,VEN1,3))
- +11 SET PAY1=$GET(^PRC(440.3,VEN1,7))
- +12 ;
- +13 ;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
- +14 ;
- +15 ;DON'T HAVE ANY PAYMENT ADDRESS INFORMATION--DON'T SEND 'VRQ'
- if PAY=""
- GOTO EXIT
- +16 ;
- +17 ;USER CHANGED VENDOR NAME
- IF $PIECE(PRCOVN,U)'=$PIECE(PRCOVA,U)
- GOTO DOIT
- +18 ;USER CHANGED 1099 VENDOR INDICATOR
- IF $PIECE(PRCOVN3,U,11)'=$PIECE(PRCOVA3,U,11)
- GOTO DOIT
- +19 ;USER CHANGED CENTERAL REMIT
- IF $PIECE(PRCOVN3,U,13)'=$PIECE(PRCOVA3,U,13)
- GOTO DOIT
- +20 ;USER CHANGED VENDOR TYPE
- IF $PIECE(PRCOVN3,U,14)'=$PIECE(PRCOVA3,U,14)
- GOTO DOIT
- +21 ;USER CHANGED PAYMENT ADDRESS1
- IF $PIECE(PAY,U,3)'=$PIECE(PAY1,U,3)
- GOTO DOIT
- +22 ;USER CHANGED PAYMENT ADDRESS2
- IF $PIECE(PAY,U,4)'=$PIECE(PAY1,U,4)
- GOTO DOIT
- +23 ;USER CHANGED PAYMENT CITY
- IF $PIECE(PAY,U,7)'=$PIECE(PAY1,U,7)
- GOTO DOIT
- +24 ;USER CHANGED PAYMENT STATE
- IF $PIECE(PAY,U,8)'=$PIECE(PAY1,U,8)
- GOTO DOIT
- +25 ;USER CHANGED PAYMENT ZIP CODE
- IF $PIECE(PAY,U,9)'=$PIECE(PAY1,U,9)
- GOTO DOIT
- +26 ;USER DIDN'T CHANGE ANYTHING NEEDED TO CREAT A VENDOR REQUEST
- GOTO EXIT
- +27 ;
- 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 SET B="VRQ^"_DATE_"^"_TIME_"^"_SITE_"^"_VEN1_"^"_$PIECE(PRCOVN3,U,4)_"^"_$SELECT($PIECE(PRCOVN3,U,5)]"":$PIECE(PRCOVN3,U,5),1:"")
- +7 SET NAME=$EXTRACT($PIECE(PRCOVN,U),1,30)
- +8 SET B=B_"^"_NAME_"^"_$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)_"^"
- +9 SET ST=$PIECE(PAY,U,8)
- if ST=""
- QUIT
- SET ST=$EXTRACT($PIECE($GET(^DIC(5,ST,0)),U,2),1,2)
- +10 SET B=B_ST_"^"_$TRANSLATE($PIECE(PAY,U,9),"-")_"^"
- +11 SET SSNT=$SELECT($PIECE(PRCOVN3,U,9)]"":$PIECE(PRCOVN3,U,9),1:"T")
- +12 SET VEND=$SELECT($PIECE(PRCOVN3,U,11)]"":$PIECE(PRCOVN3,U,11),1:"N")
- if VEND="N"
- SET SSNT=""
- +13 SET B=B_SSNT_"^"_VEND_"^"_$PIECE(PRCOVN3,U,14)_"^N^C^~"
- +14 ;
- +15 WRITE !,"Creating the FMS VENDOR REQUEST."
- +16 SET $PIECE(^PRC(440,VEN1,3),U,12)="P"
- +17 SET DIR(0)="E"
- +18 SET DIR("A")="Enter RETURN to continue"
- +19 DO ^DIR
- +20 KILL DIR
- +21 WRITE !
- +22 ;
- +23 ;REQUEST GENERIC CODE SHEET PACKAGE SET UP AN ENTRY IN FILE 2100.1
- DO CONTROL^GECSUFMS("I",SITE,TRANS,"VR","","","","Vendor Request")
- +24 ;
- +25 ;ENTER THE 'VRQ' SEGMENT INTO FILE 2100.1 RECORD CREATED IN PREVIOUS CALL
- DO SETCS^GECSSTAA(GECSFMS("DA"),B)
- +26 ;
- +27 ;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")
- +28 ;
- +29 QUIT
- 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
