source: WorldVistAEHR/trunk/r/TOOLKIT-AWCM-XD-XIN-XPAR-XQAB-XT-XUC-XUR-ZIN-ZTED/XDRMPACK.m@ 1259

Last change on this file since 1259 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.7 KB
Line 
1XDRMPACK ;IHS/OHPRD/JCM - CHECKS PACKAGE FILE FOR SPECIAL MERGES; [ 08/13/92 09:50 AM ]
2 ;;7.3;TOOLKIT;;Apr 25, 1995
3START ;
4 I '$D(^DIC(9.4,"AMRG",XDRFL)) D STATUS G END
5 W:'$D(XDRM("NOTALK")) !!!,"I am now checking the different packages to see if they have data "
6 W:'$D(XDRM("NOTALK")) !,"for this record, I will also notify the packages about the merge"
7 W:'$D(XDRM("NOTALK")) !,"This may take awhile, please be patient.",!!
8 S XDRMPACK=""
9LOOP ; Checks packages that affects patient merge and edits Merge Package
10 ; mulitple of Duplicate Record file.
11 F XDRMI=0:0 S XDRMPACK=$O(^DIC(9.4,"AMRG",XDRFL,XDRMPACK)) Q:'XDRMPACK D PACKAGE ; Control point- gets packages that affect patient merge
12 K XDRMI
13END D EOJ ;------->End of Job
14 Q
15 ;
16PACKAGE ; Checks packages that affects patient merge
17 ;
18 I '$D(^VA(15,XDRMPDA,11,XDRMPACK)) D ADD I 1
19 E I $P(^VA(15,XDRMPDA,11,XDRMPACK,0),U,2)=2 D CHECK I XDRMPACK("STATUS")'=2 D EDIT
20 Q
21ADD ;
22 S DIE=15,DA=XDRMPDA,DR="1101///`"_XDRMPACK
23 S DR(2,15.01101)=".02////"
24 D ^DIE K DIE,DR,DA
25 D CHECK
26 S DA(1)=XDRMPDA,DA=XDRMPACK
27 S DIE="^VA(15,"_DA(1)_",11,"
28 S DR=".02////"_XDRMPACK("STATUS")
29 D ^DIE K DIE,DR,DA
30 Q
31CHECK ;
32 S XDRZ=0
33 I $D(^DIC(9.4,XDRMPACK,20,XDRFL,1)) X ^DIC(9.4,XDRMPACK,20,XDRFL,1)
34 S XDRMPACK("STATUS")=$S('XDRZ:2,1:0)
35 I XDRZ,$D(^DIC(9.4,XDRMPACK,20,XDRFL,0)),$P(^(0),U,3)]"" S XDRMPACK("STATUS")=1
36 K XDRZ
37 Q
38EDIT ;
39 S DA(1)=XDRMPDA,DA=XDRMPACK
40 S DIE="^VA(15,"_DA(1)_",11,"
41 S DR=".02////"_XDRMPACK("STATUS")
42 D ^DIE K DIE,DR,DA
43 Q
44 ;
45STATUS ; Changes merge status field to ready if no packages affect merge
46 S DIE="^VA(15,",DA=XDRMPDA,DR=".05///1"
47 D ^DIE K DIE,DR,DA
48 Q
49EOJ ; End of job and cleanup
50 K XDRMPACK,XDRMI
51 Q
Note: See TracBrowser for help on using the repository browser.