| 1 | XDRMPACK ;IHS/OHPRD/JCM - CHECKS PACKAGE FILE FOR SPECIAL MERGES; [ 08/13/92 09:50 AM ]
|
|---|
| 2 | ;;7.3;TOOLKIT;;Apr 25, 1995
|
|---|
| 3 | START ;
|
|---|
| 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=""
|
|---|
| 9 | LOOP ; 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
|
|---|
| 13 | END D EOJ ;------->End of Job
|
|---|
| 14 | Q
|
|---|
| 15 | ;
|
|---|
| 16 | PACKAGE ; 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
|
|---|
| 21 | ADD ;
|
|---|
| 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
|
|---|
| 31 | CHECK ;
|
|---|
| 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
|
|---|
| 38 | EDIT ;
|
|---|
| 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 | ;
|
|---|
| 45 | STATUS ; 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
|
|---|
| 49 | EOJ ; End of job and cleanup
|
|---|
| 50 | K XDRMPACK,XDRMI
|
|---|
| 51 | Q
|
|---|
