Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRCVLIC

PRCVLIC.m

Go to the documentation of this file.
  1. PRCVLIC ;WOIFO/BMM - update message for 2237 line item cancel; 2/11/05 ; 3/24/05 2:50pm
  1. V ;;5.1;IFCAP;**81**;Oct 20, 2000
  1. ;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;
  1. Q
  1. ;
  1. EN ;code to send update to DM notifying of canceled line item
  1. ;in 2237
  1. ;DA, DA(1) are defined since this code is called from a MUMPS
  1. ;cross-reference
  1. ;
  1. ;do not process if 2237 # not cross-referenced in DynaMed IFCAP
  1. ;Audit file #414.02
  1. ;
  1. ;FIELDS RETRIEVED:
  1. ;.01 - transaction number
  1. ;.5 - station number
  1. ;5 - Dt requested
  1. ;12 - vendor number
  1. ;
  1. ;OTHER DATA RETRIEVED:
  1. ;DUZ - PRCVDZ
  1. ;PRCVLN, PRCVFN - last name, first name from New Person (#200)
  1. ;
  1. Q:$$GET^XPAR("SYS","PRCV COTS INVENTORY",1,"Q")'=1
  1. N PRCVA,PRCVFH,PRCVNM
  1. ;create PRCVA array of header fields in 410
  1. S PRCVFH=".01;.5;5;12"
  1. D GETS^DIQ(410,DA(1)_",",PRCVFH,"I","PRCVA")
  1. ;quit if 2237# not in 414.02
  1. Q:'$D(^PRCV(414.02,"D",PRCVA(410,DA(1)_",",.01,"I")))
  1. D:'$D(DT) DT^DICRW
  1. ;add other data to PRCVA
  1. S PRCVA(410,DA(1)_",","DT")=$$NOW^XLFDT
  1. S PRCVA(410,DA(1)_",","DT7")=$$FMADD^XLFDT($$NOW^XLFDT,7,"","","")
  1. S PRCVA(410,DA(1)_",","DUZ")=DUZ,PRCVNM=$$GET1^DIQ(200,DUZ_",",.01)
  1. S PRCVA(410,DA(1)_",","LN")=$P(PRCVNM,",")
  1. S PRCVA(410,DA(1)_",","FN")=$P(PRCVNM,",",2)
  1. S PRCVA(410,DA(1)_",","DA1")=DA(1)
  1. ;add PRCVA to data in job
  1. M X1(9999)=PRCVA(410,DA(1)_",")
  1. ;call Kernel API, job off rest
  1. D OPKG^XUHUI("","PRCV 410 2237 LINE ITEM CANCEL","K","AH")
  1. K X1(9999)
  1. ;
  1. Q
  1. ;
  1. CREATEM ;use data from 410 and 441 to create ^XTMP structure for sending
  1. ;message to DynaMed
  1. ;
  1. ;XUHUIX1 ARRAY SHOULD BE:
  1. ;XUHUIX1(9999,.01,"I") - transaction number (file 410, field .01)
  1. ;XUHUIX1(9999,.5,"I") - station number (410, 0.5)
  1. ;XUHUIX1(9999,5,"I") - date requested (410, 5)
  1. ;XUHUIX1(9999,12,"I") - vendor number (410, 12)
  1. ;XUHUIX1(9999,"DT") - FM date now
  1. ;XUHUIX1(9999,"DT7") - FM date 7 days from now
  1. ;XUHUIX1(9999,"DUZ") - user DUZ
  1. ;XUHUIX1(9999,"FN") - user first name
  1. ;XUHUIX1(9999,"LN") - user last name
  1. ;XUHUIX1(9999,"DA1") - DA(1), IEN of 2237 in 410
  1. ;XUHUIX1(1) - LINE ITEM NUMBER (410.02,.01)
  1. ;XUHUIX1(2) - QUANTITY (410.02,2)
  1. ;XUHUIX1(3) - UNIT OF PURCHASE (410.02,3)
  1. ;XUHUIX1(4) - BOC (410.02,4)
  1. ;XUHUIX1(5) - ITEM MASTER FILE NO. (410.02,5)
  1. ;XUHUIX1(6) - STOCK NUMBER (410.02,6)
  1. ;XUHUIX1(7) - EST. ITEM (UNIT) COST (410.02,7)
  1. ;XUHUIX1(8) - DM DOC ID (410.02,17)
  1. ;XUHUIX1(9) - DATE NEEDED BY (410.02,18)
  1. ;
  1. ;other variables/data:
  1. ;PRCVST - station number
  1. ;PRCVNIF - NIF #
  1. ;PRCVPM - packaging multiple
  1. ;PRCVFV - FMS Vendor #
  1. ;PRCV2237 - ^XTMP message id
  1. ;PRCVNR - number of records (always 1)
  1. ;
  1. N PRCV2237,PRCVCT,PRCVDTD,PRCVDZ,PRCVFV,PRCVH,PRCVLI,PRCVND
  1. N PRCVNR,PRCVOCC,PRCVUP,PRCVPM,PRCVST,PRCVUM
  1. S PRCVH=$H,PRCVOCC="CA",PRCVNR=1,(PRCVUP,PRCVND,PRCVUM)=""
  1. S (PRCVPM,PRCVFV)=0
  1. S PRCVST=$$GET1^DIQ(4,$$KSP^XUPARAM("INST")_",",99)
  1. ;S PRCVST=XUHUIX1(9999,.5,"I")
  1. ;now- line items in PRCVLI, rest in XUHUIX1
  1. ;get NIF#, pkging multiple from 441
  1. S PRCVITM=XUHUIX1(5),PRCVVN=XUHUIX1(9999,12,"I")
  1. S PRCVNIF=$$GET1^DIQ(441,PRCVITM_",",51)
  1. S PRCVPM=$$GET1^DIQ(441.01,PRCVVN_","_PRCVITM_",",1.6)
  1. S PRCVFV=$$GET1^DIQ(440,PRCVVN_",",34)
  1. S PRCVUP=$P($G(^PRCD(420.5,XUHUIX1(3),0)),U)
  1. ;now- build ^XTMP
  1. S PRCV2237="PRCVUP*"_XUHUIX1(9999,.01,"I")
  1. ;0 node
  1. S PRCVND=XUHUIX1(9999,"DT7")_"^"_XUHUIX1(9999,"DT")
  1. K ^XTMP(PRCV2237,PRCVH)
  1. S PRCVUM="^Transmit message to DynaMed for updates"
  1. S ^XTMP(PRCV2237,0)=PRCVND_PRCVUM
  1. S ^XTMP(PRCV2237,PRCVH,0)=PRCVND_"^Line item cancel message to DynaMed"
  1. ;1 node
  1. S PRCVND=PRCVNR_"^"_PRCVST_"^"_XUHUIX1(9999,"DUZ")
  1. S PRCVND=PRCVND_"^"_XUHUIX1(9999,"LN")_"^"_XUHUIX1(9999,"FN")
  1. S PRCVND=PRCVND_"^"_XUHUIX1(9999,"DA1")
  1. S ^XTMP(PRCV2237,PRCVH,1)=PRCVND
  1. ;2 node
  1. S PRCVND=PRCVOCC_"^"_XUHUIX1(5)_"^"_XUHUIX1(2)
  1. S PRCVND=PRCVND_"^"_XUHUIX1(9999,12,"I")_"^"_PRCVFV
  1. S PRCVND=PRCVND_"^"_XUHUIX1(7)_"^"_XUHUIX1(8)_"^"_XUHUIX1(9)
  1. S PRCVND=PRCVND_"^"_PRCVUP_"^"_XUHUIX1(6)_"^"_PRCVPM
  1. S PRCVND=PRCVND_"^"_$P(XUHUIX1(4)," ")_"^"_PRCVNIF
  1. S ^XTMP(PRCV2237,PRCVH,2,1)=PRCVND
  1. ;
  1. ;call Vic's code to process the data you put in ^XTMP
  1. D BEGIN^PRCVEE1(PRCV2237,PRCVH)
  1. ;
  1. ;update Audit file
  1. D UPDAUD
  1. ;
  1. Q
  1. ;
  1. UPDAUD ;update the Audit file entry for this DM Doc ID
  1. ;XUHUIX1(8) is DM Doc ID
  1. ;adding 2237# (414.02 #7), Date/Time Removed From IFCAP
  1. ;(414.02, 8), and Who Deleted (414.02, 9)
  1. ;
  1. ;note: the error of DM Doc ID being null won't happen here because
  1. ;this code isn't called unless the protocol "PRCV 410 2237 LINE ITEM
  1. ;CANCEL" fires, and that won't fire unless the cross reference on the
  1. ;410.02 Line Item field fires, and that won't happen if the DM Doc ID
  1. ;field of the 2237 line item being canceled is NULL.
  1. ;
  1. N PRCVAIEN,PRCVMSG,PRCVADR
  1. S PRCVAIEN=$O(^PRCV(414.02,"B",XUHUIX1(8),0))
  1. ;if no entry found in Audit file, send bulletin
  1. I PRCVAIEN="" D Q
  1. . S XMB(1)="canceling a line item during edit of 2237 #"
  1. . S XMB(1)=XMB(1)_XUHUIX1(9999,.01,"I")
  1. . S XMB(2)=XUHUIX1(8)
  1. . S XMB(3)="the item is missing from the DynaMed Audit file (#414.02)"
  1. . K ^TMP($J,"PRCVLIC") S PRCVTMP="PRCVLIC"
  1. . S ^TMP($J,"PRCVLIC",1,0)=""
  1. . S ^TMP($J,"PRCVLIC",2,0)="2237 #: "_XUHUIX1(9999,.01,"I")
  1. . S ^TMP($J,"PRCVLIC",3,0)="Date/time deleted: "_XUHUIX1(9999,"DT")
  1. . S ^TMP($J,"PRCVLIC",4,0)="Who deleted: "_XUHUIX1(9999,"LN")_","_XUHUIX1(9999,"FN")_" ("_XUHUIX1(9999,"DUZ")_")"
  1. . S ^TMP($J,"PRCVLIC",5,0)="Item #: "_XUHUIX1(5)
  1. . S PRCVFCP=$P(XUHUIX1(9999,.01,"I"),"-",4)
  1. . S PRCVST=XUHUIX1(9999,.5,"I")
  1. . D DMERXMB(PRCVTMP,PRCVST,PRCVFCP)
  1. ;
  1. N PRCVA
  1. S PRCVA(414.02,PRCVAIEN_",",7)=XUHUIX1(9999,.01,"I")
  1. S PRCVA(414.02,PRCVAIEN_",",8)=XUHUIX1(9999,"DT")
  1. S PRCVA(414.02,PRCVAIEN_",",9)=XUHUIX1(9999,"DUZ")
  1. D FILE^DIE("","PRCVA")
  1. ;
  1. I $D(^TMP("DIERR",$J)) D Q
  1. . S XMB(1)="canceling a line item during edit of 2237 #"
  1. . S XMB(1)=XMB(1)_XUHUIX1(9999,.01,"I")
  1. . S XMB(2)=XUHUIX1(8)
  1. . S XMB(3)="error while updating DynaMed Audit file (#414.02)"
  1. . K ^TMP($J,"PRCVLIC") S PRCVTMP="PRCVLIC"
  1. . S ^TMP($J,"PRCVLIC",1,0)=""
  1. . S ^TMP($J,"PRCVLIC",2,0)="2237 #: "_XUHUIX1(9999,.01,"I")
  1. . S ^TMP($J,"PRCVLIC",3,0)="Item #: "_XUHUIX1(5)
  1. . S ^TMP($J,"PRCVLIC",4,0)="Date/time deleted: "_XUHUIX1(9999,"DT")
  1. . S ^TMP($J,"PRCVLIC",5,0)="Who deleted: "_XUHUIX1(9999,"LN")_","_XUHUIX1(9999,"FN")_" ("_XUHUIX1(9999,"DUZ")_")"
  1. . S ^TMP($J,"PRCVLIC",6,0)="Error text: "_$G(^TMP("DIERR",$J,1,"TEXT",1))
  1. . S PRCVFCP=$P(XUHUIX1(9999,.01,"I"),"-",4)
  1. . S PRCVST=XUHUIX1(9999,.5,"I")
  1. . D DMERXMB(PRCVTMP,PRCVST,PRCVFCP)
  1. Q
  1. ;
  1. DMERXMB(PRCVTMP,PRCVST,PRCVFCP) ;create a bulletin to send to FCP users
  1. ;notifying of line item missing a DM Doc ID value or error
  1. ;updating the Audit file.
  1. ;
  1. ;the bulletin has these variable components:
  1. ;XMB - bulletin name (PRCV_AUDIT_FILE_ERROR)
  1. ;XMB(1) - action/event/identifier ex. "line item cancel during edit
  1. ; of 2237 #516-05-2-076-0445"
  1. ;XMB(2) - DM Doc ID value
  1. ;XMB(3) - error reason, either "an error updating the Audit file" or
  1. ; "the item was missing its DynaMed Doc ID value"
  1. ;XMTEXT - overflow global in ^TMP, contains values that would've
  1. ; been added to Audit file had error not occurred
  1. ;XMSUB - set in Bulletin file, "ERROR UPDATING DYNAMED AUDIT FILE"
  1. ;XMY - array of FCP users to receive bulletin, built in GETFCPU
  1. ;XMDUZ - new value ensures bulletin is seen by user as new mail
  1. ;
  1. ;input parameters
  1. ;PRCVTMP - suscript for ^TMP array in bulletin
  1. ;PRCVFCP - fund control point
  1. ;PRCVST - station number
  1. ;
  1. N XMY,XMDUZ
  1. I $G(PRCVTMP)'="" S XMTEXT="^TMP($J,"""_PRCVTMP_""","
  1. S XMB="PRCV_AUDIT_FILE_ERROR"
  1. S XMDUZ="DOCUMENT PROCESSOR"
  1. ;D GETFCPU(.XMY,PRCVST,PRCVFCP)
  1. ;send to special mail group
  1. S XMY("G.PRCV Audit File Alerts")=""
  1. D ^XMB
  1. Q
  1. ;
  1. GETFCPU(PRCVXMY,PRCVST,PRCVFCP) ;retrieve all the FCP users who are Control
  1. ;Point Officials or Control Point Clerks and are enabled to
  1. ;receive the bulletin
  1. ;PRCVFCP is fund control point
  1. ;PRCVST is station number
  1. ;
  1. N A,I,PRCVX K PRCVXMY
  1. S PRCVX="",PRCVFCP=+PRCVFCP
  1. F I=0:0 S PRCVX=$O(^PRC(420,PRCVST,1,PRCVFCP,1,PRCVX)) Q:PRCVX="" D
  1. . S A=$G(^(PRCVX,0))
  1. . I $P(A,U,3)="Y",($P(A,U,2)=1!($P(A,U,2)=2)) S PRCVXMY(PRCVX)=""
  1. ;S (PRCVXMY(36002),PRCVXMY(35994),PRCVXMY(35993))=""
  1. Q
  1. ;
  1. CHKDM(PRCVSUB) ;function that checks if the given value in PRCVSUB
  1. ;is in the Audit file index passed in PRCVIND.
  1. ;1=yes, 0=no
  1. ;
  1. N PRCVP2,PRCVPC,PRCVPI,PRCVVAL
  1. S (PRCVPI,PRCVP2,PRCVVAL)=0
  1. D1 I $D(^PRCV(414.02,"D",PRCVSUB)) S PRCVVAL=1 G EX
  1. ;not there, check for child
  1. S PRCVPI=$O(^PRCS(410,"B",PRCVSUB,0))
  1. I +PRCVPI=0 G EX
  1. S PRCVPC=$P($G(^PRCS(410,PRCVPI,10)),U,2)
  1. I +PRCVPC=0 G EX
  1. S PRCVSUB=PRCVPC G D1
  1. EX Q PRCVVAL
  1. ;