- 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 Feb 18, 2025@23:38:49 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
