- 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 Jan 18, 2025@03:21:18 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 ;