PRCOVUP4 ;WISC/DJM-VENDOR UPDATE SERVER BULLETIN ;7/21/95 2:52 PM
V ;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
BUL ;THIS ROUTINE WILL BE CALLED FROM 'PRCOVUP'.
;'ENTRY' IS THE INTERNAL ENTRY NUMBER FOR THE RECORD IN FILE 440
;AND 440.3.
;
;THIS ROUTINE WILL CREATE A MAILMAN BULLETIN, SENT TO THE 'FMS' MAIL
;GROUP, FOR EACH VENDOR FILE ENTRY THAT IS UPDATED. UPDATING WILL BE
;CAUSED BY THE SITE SENDING A 'VRQ' OR BY FMS BROADCASTING A 'VUP'.
;
N CRN,CRO,LCNT,LEN,MTIN,MTIO,PHIN,PHIO,PRCLN,VO3,VO7,VT,VTYO,XMB,XMDUZ,XMTEXT,ZIP,ZIPO
S VO3=$G(^PRC(440.3,ENTRY,3)),VO7=$G(^PRC(440.3,ENTRY,7))
S XMDUZ="VUP Server Interface",XMB="PRCVUP" ;,XMY("G.FMS")=""
S XMB(1)=$P($G(^PRC(440,ENTRY,0)),U),XMTEXT="PRCLN("
K LEN S LCNT=1,$P(LEN," ",40)=" "
I $P(LINE,U,19)="D" S PRCLN(LCNT)="This vendor has been inactivated by FMS.",LCNT=LCNT+1
S PRCLN(LCNT)=" ",LCNT=LCNT+1
S PRCLN(LCNT)="FMS VENDOR CODE: "_$P(LINE,U,6)_" ALT-ADDR-IND: "_$P(LINE,U,7),LCNT=LCNT+1
S PRCLN(LCNT)=" ",LCNT=LCNT+1
S PRCLN(LCNT)=" ORIGINAL UPDATED",LCNT=LCNT+1
S PRCLN(LCNT)=" ENTRY ENTRY",LCNT=LCNT+1
S PRCLN(LCNT)=" ",LCNT=LCNT+1
S PRCLN(LCNT)=" "_$P(LINE,U,8),LCNT=LCNT+1
S PRCLN(LCNT)=$P(VO7,U,3)_LEN,PRCLN(LCNT)=$E(PRCLN(LCNT),1,40)_$P(LINE,U,9),LCNT=LCNT+1
S:$P(VO7,U,4)]""!($P(LINE,U,10)]"") PRCLN(LCNT)=$P(VO7,U,4)_LEN,PRCLN(LCNT)=$E(PRCLN(LCNT),1,40)_$P(LINE,U,10),LCNT=LCNT+1
S ZIP=$P(LINE,U,13),ZIP=$S($L(ZIP)=9:$E(ZIP,1,5)_"-"_$E(ZIP,6,9),1:ZIP)
S ZIPO=$P(VO7,U,9) I ZIPO'["-" S ZIPO=$S($L(ZIPO)=9:$E(ZIPO,1,5)_"-"_$E(ZIPO,6,9),1:ZIPO)
S PRCLN(LCNT)=$P(VO7,U,7)_","_$E($P($G(^DIC(5,+$P(VO7,U,8),0)),U,2),1,2)_" "_ZIPO_LEN
S PRCLN(LCNT)=$E(PRCLN(LCNT),1,40)_$P(LINE,U,11)_","_$P(LINE,U,12)_" "_ZIP,LCNT=LCNT+1
S PRCLN(LCNT)="1099 VENDOR INDICATOR: "_$S($P(VO3,U,11)="Y":"YES",$P(VO3,U,11)="N":"NO",1:"")_LEN,PRCLN(LCNT)=$E(PRCLN(LCNT),1,40)_$S($P(LINE,U,15)="Y":"YES",$P(LINE,U,15)="N":"NO",1:""),LCNT=LCNT+1
S VT=$P(VO3,U,14) D VENDTY S VTYO=VT,VT=$P(LINE,U,16) D VENDTY
S PRCLN(LCNT)="VENDOR TYPE: "_VTYO_LEN,PRCLN(LCNT)=$E(PRCLN(LCNT),1,40)_VT,LCNT=LCNT+1
S PRCLN(LCNT)="CENTERAL REMIT: ",CRO=$P(VO3,U,13)
S CRO=$S(CRO="Y":"YES",CRO="N":"NO",1:""),PRCLN(LCNT)=PRCLN(LCNT)_CRO_LEN,PRCLN(LCNT)=$E(PRCLN(LCNT),1,40)
S CRN=$P(LINE,U,17),CRN=$S(CRN="Y":"YES",CRN="N":"NO",1:""),PRCLN(LCNT)=PRCLN(LCNT)_CRN,LCNT=LCNT+1
S PRCLN(LCNT)="MTI ACTION: ",MTIO=$P(VO3,U,15),MTIO=$S(MTIO="A":"ADD",MTIO="F":"ADD IFCAP ONLY",MTIO="C":"CHANGE",MTIO="D":"DELETE",1:""),PRCLN(LCNT)=PRCLN(LCNT)_MTIO_LEN
S PRCLN(LCNT)=$E(PRCLN(LCNT),1,40),MTIN=$P(LINE,U,19),MTIN=$S(MTIN="A":"ADD",MTIN="F":"ADD IFCAP ONLY",MTIN="C":"CHANGE",MTIN="D":"DELETE",1:""),PRCLN(LCNT)=PRCLN(LCNT)_MTIN,LCNT=LCNT+1
S PRCLN(LCNT)="PAYMENT HOLD INDICATOR: ",PHIO=$P(VO3,U,10),PHIO=$S(PHIO="N":"NO",PHIO="Y":"YES",PHIO="C":"CORRESPONDENCE",1:""),PRCLN(LCNT)=PRCLN(LCNT)_PHIO_LEN
S PRCLN(LCNT)=$E(PRCLN(LCNT),1,40),PHIN=$P(LINE,U,20),PHIN=$S(PHIN="N":"NO",PHIN="Y":"YES",PHIN="C":"CORRESPONDENCE",1:""),PRCLN(LCNT)=PRCLN(LCNT)_PHIN
D ^XMB
Q
;
VENDTY ;VENDOR TYPE -- VT = VALUE TO CONVERT
; VT = RETURNED VALUE
N VT1
S VT1=$S(VT="A":"AGENT CHASHIER",VT="C":"COMMERCIAL",VT="E":"EMPLOYEE",VT="F":"FEDERAL GOVERNMENT",VT="G":"GSA",VT="I":"INDIVIDUALS-OTHER",1:"")
S:VT1="" VT1=$S(VT="O":"OTHER COUNTRIES",VT="R":"COMMERCIAL-RECURRING PMTS",VT="U":"UTILITY COMPANIES",VT="V":"VETERANS",VT="K":"CANTEEN",1:"")
S VT=VT1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCOVUP4 3625 printed Apr 09, 2024@21:02:53 Page 2
PRCOVUP4 ;WISC/DJM-VENDOR UPDATE SERVER BULLETIN ;7/21/95 2:52 PM
V ;;5.1;IFCAP;;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
BUL ;THIS ROUTINE WILL BE CALLED FROM 'PRCOVUP'.
+1 ;'ENTRY' IS THE INTERNAL ENTRY NUMBER FOR THE RECORD IN FILE 440
+2 ;AND 440.3.
+3 ;
+4 ;THIS ROUTINE WILL CREATE A MAILMAN BULLETIN, SENT TO THE 'FMS' MAIL
+5 ;GROUP, FOR EACH VENDOR FILE ENTRY THAT IS UPDATED. UPDATING WILL BE
+6 ;CAUSED BY THE SITE SENDING A 'VRQ' OR BY FMS BROADCASTING A 'VUP'.
+7 ;
+8 NEW CRN,CRO,LCNT,LEN,MTIN,MTIO,PHIN,PHIO,PRCLN,VO3,VO7,VT,VTYO,XMB,XMDUZ,XMTEXT,ZIP,ZIPO
+9 SET VO3=$GET(^PRC(440.3,ENTRY,3))
SET VO7=$GET(^PRC(440.3,ENTRY,7))
+10 ;,XMY("G.FMS")=""
SET XMDUZ="VUP Server Interface"
SET XMB="PRCVUP"
+11 SET XMB(1)=$PIECE($GET(^PRC(440,ENTRY,0)),U)
SET XMTEXT="PRCLN("
+12 KILL LEN
SET LCNT=1
SET $PIECE(LEN," ",40)=" "
+13 IF $PIECE(LINE,U,19)="D"
SET PRCLN(LCNT)="This vendor has been inactivated by FMS."
SET LCNT=LCNT+1
+14 SET PRCLN(LCNT)=" "
SET LCNT=LCNT+1
+15 SET PRCLN(LCNT)="FMS VENDOR CODE: "_$PIECE(LINE,U,6)_" ALT-ADDR-IND: "_$PIECE(LINE,U,7)
SET LCNT=LCNT+1
+16 SET PRCLN(LCNT)=" "
SET LCNT=LCNT+1
+17 SET PRCLN(LCNT)=" ORIGINAL UPDATED"
SET LCNT=LCNT+1
+18 SET PRCLN(LCNT)=" ENTRY ENTRY"
SET LCNT=LCNT+1
+19 SET PRCLN(LCNT)=" "
SET LCNT=LCNT+1
+20 SET PRCLN(LCNT)=" "_$PIECE(LINE,U,8)
SET LCNT=LCNT+1
+21 SET PRCLN(LCNT)=$PIECE(VO7,U,3)_LEN
SET PRCLN(LCNT)=$EXTRACT(PRCLN(LCNT),1,40)_$PIECE(LINE,U,9)
SET LCNT=LCNT+1
+22 if $PIECE(VO7,U,4)]""!($PIECE(LINE,U,10)]"")
SET PRCLN(LCNT)=$PIECE(VO7,U,4)_LEN
SET PRCLN(LCNT)=$EXTRACT(PRCLN(LCNT),1,40)_$PIECE(LINE,U,10)
SET LCNT=LCNT+1
+23 SET ZIP=$PIECE(LINE,U,13)
SET ZIP=$SELECT($LENGTH(ZIP)=9:$EXTRACT(ZIP,1,5)_"-"_$EXTRACT(ZIP,6,9),1:ZIP)
+24 SET ZIPO=$PIECE(VO7,U,9)
IF ZIPO'["-"
SET ZIPO=$SELECT($LENGTH(ZIPO)=9:$EXTRACT(ZIPO,1,5)_"-"_$EXTRACT(ZIPO,6,9),1:ZIPO)
+25 SET PRCLN(LCNT)=$PIECE(VO7,U,7)_","_$EXTRACT($PIECE($GET(^DIC(5,+$PIECE(VO7,U,8),0)),U,2),1,2)_" "_ZIPO_LEN
+26 SET PRCLN(LCNT)=$EXTRACT(PRCLN(LCNT),1,40)_$PIECE(LINE,U,11)_","_$PIECE(LINE,U,12)_" "_ZIP
SET LCNT=LCNT+1
+27 SET PRCLN(LCNT)="1099 VENDOR INDICATOR: "_$SELECT($PIECE(VO3,U,11)="Y":"YES",$PIECE(VO3,U,11)="N":"NO",1:"")_LEN
SET PRCLN(LCNT)=$EXTRACT(PRCLN(LCNT),1,40)_$SELECT($PIECE(LINE,U,15)="Y":"YES",$PIECE(LINE,U,15)="N":"NO",1:"")
SET LCNT=LCNT+1
+28 SET VT=$PIECE(VO3,U,14)
DO VENDTY
SET VTYO=VT
SET VT=$PIECE(LINE,U,16)
DO VENDTY
+29 SET PRCLN(LCNT)="VENDOR TYPE: "_VTYO_LEN
SET PRCLN(LCNT)=$EXTRACT(PRCLN(LCNT),1,40)_VT
SET LCNT=LCNT+1
+30 SET PRCLN(LCNT)="CENTERAL REMIT: "
SET CRO=$PIECE(VO3,U,13)
+31 SET CRO=$SELECT(CRO="Y":"YES",CRO="N":"NO",1:"")
SET PRCLN(LCNT)=PRCLN(LCNT)_CRO_LEN
SET PRCLN(LCNT)=$EXTRACT(PRCLN(LCNT),1,40)
+32 SET CRN=$PIECE(LINE,U,17)
SET CRN=$SELECT(CRN="Y":"YES",CRN="N":"NO",1:"")
SET PRCLN(LCNT)=PRCLN(LCNT)_CRN
SET LCNT=LCNT+1
+33 SET PRCLN(LCNT)="MTI ACTION: "
SET MTIO=$PIECE(VO3,U,15)
SET MTIO=$SELECT(MTIO="A":"ADD",MTIO="F":"ADD IFCAP ONLY",MTIO="C":"CHANGE",MTIO="D":"DELETE",1:"")
SET PRCLN(LCNT)=PRCLN(LCNT)_MTIO_LEN
+34 SET PRCLN(LCNT)=$EXTRACT(PRCLN(LCNT),1,40)
SET MTIN=$PIECE(LINE,U,19)
SET MTIN=$SELECT(MTIN="A":"ADD",MTIN="F":"ADD IFCAP ONLY",MTIN="C":"CHANGE",MTIN="D":"DELETE",1:"")
SET PRCLN(LCNT)=PRCLN(LCNT)_MTIN
SET LCNT=LCNT+1
+35 SET PRCLN(LCNT)="PAYMENT HOLD INDICATOR: "
SET PHIO=$PIECE(VO3,U,10)
SET PHIO=$SELECT(PHIO="N":"NO",PHIO="Y":"YES",PHIO="C":"CORRESPONDENCE",1:"")
SET PRCLN(LCNT)=PRCLN(LCNT)_PHIO_LEN
+36 SET PRCLN(LCNT)=$EXTRACT(PRCLN(LCNT),1,40)
SET PHIN=$PIECE(LINE,U,20)
SET PHIN=$SELECT(PHIN="N":"NO",PHIN="Y":"YES",PHIN="C":"CORRESPONDENCE",1:"")
SET PRCLN(LCNT)=PRCLN(LCNT)_PHIN
+37 DO ^XMB
+38 QUIT
+39 ;
VENDTY ;VENDOR TYPE -- VT = VALUE TO CONVERT
+1 ; VT = RETURNED VALUE
+2 NEW VT1
+3 SET VT1=$SELECT(VT="A":"AGENT CHASHIER",VT="C":"COMMERCIAL",VT="E":"EMPLOYEE",VT="F":"FEDERAL GOVERNMENT",VT="G":"GSA",VT="I":"INDIVIDUALS-OTHER",1:"")
+4 if VT1=""
SET VT1=$SELECT(VT="O":"OTHER COUNTRIES",VT="R":"COMMERCIAL-RECURRING PMTS",VT="U":"UTILITY COMPANIES",VT="V":"VETERANS",VT="K":"CANTEEN",1:"")
+5 SET VT=VT1
+6 QUIT
