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