source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DG17202.m@ 1663

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

initial load of WorldVistAEHR
File size: 4.9 KB
RevLine 
[613]1DG17202 ;BHM/RGY,ALS-Create new request for patient demographic change ;FEB 20, 1998
2 ;;5.3;Registration;**172**;Aug 13, 1993
3ADD(FILE) ;
4 NEW DIC,D0,DIE,DA,X,DLAYGO,DR,RGOK,EVN,DINUM
5 F EVN=+$P(^XTMP("DGTMP",FILE,0),"^",3)+1:1 L +^XTMP("DGTMP",FILE,EVN):0 I $T S RGOK=0 D L -^XTMP("DGTMP",FILE,EVN) Q:RGOK
6 .I $D(^XTMP("DGTMP",FILE,EVN)) Q
7 .S DINUM=EVN,DIC="^XTMP(""DGTMP"","_FILE_",",DIC(0)="L",DLAYGO=FILE,X=EVN K DD,D0 D FILE^DICN K DIC,DLAYGO,D0
8 .S RGOK=1
9 .Q
10 Q EVN
11ADDR(FILE,NAME) ;
12 NEW DIC,D0,DIE,DA,X,DLAYGO,DR,RGOK,EVN,DINUM
13 F EVN=+$P(^DIC(FILE,0),"^",3)+1:1 L +^DIC(FILE,EVN):0 I $T S RGOK=0 D L -^DIC(FILE,EVN) Q:RGOK
14 .I $D(^DIC(FILE,EVN)) Q
15 .S DINUM=EVN,DIC="^DIC("_FILE_",",DIC(0)="L",DLAYGO=FILE,X=NAME K DD,D0 D FILE^DICN K DIC,DLAYGO,D0
16 .S RGOK=1
17 .Q
18 Q EVN
19CONV ;Start conversion process
20 NEW TASK
21 I '$$CHK() Q
22 I '$$CHK2() Q
23 L +^XTMP("DGTMP",390.1,"ASTOP"):1 E Q
24 F TASK=0:0 S TASK=$O(^XTMP("DGTMP",390.1,TASK)) Q:'TASK I $P(^XTMP("DGTMP",390.1,TASK,0),"^",9)="" D TASK(TASK) I $G(^XTMP("DGTMP",390.1,"ASTOP"))="YES" D SEND G Q1
25 D SEND,JOBKILL
26Q1 Q
27SEND ;
28 L -^XTMP("DGTMP",390.1,"ASTOP")
29 D BROAD^DG17204
30 Q
31TASK(TASK) ;Convert a file (task)
32 NEW GLOB,ENTRY,NODE,OV,PIECE,N0,NV,TYPE,COUNT,FIELD
33 S N0=$G(^XTMP("DGTMP",390.1,TASK,0)) I N0="" Q
34 S COUNT=0,GLOB="^"_$P(N0,"^",4),NODE=$P(N0,"^",5),FIELD=$P(N0,"^",3),PIECE=$P(N0,"^",6),TYPE=$P(N0,"^",7)
35 I $P(^XTMP("DGTMP",390.1,TASK,0),"^",9)]"" Q
36 I '$$CHK1(TYPE) D NOW^%DTC S $P(^XTMP("DGTMP",390.1,TASK,0),"^",9)=% K % Q
37 F ENTRY=$P(N0,"^",8):0 S ENTRY=$O(@(GLOB_ENTRY_")")) Q:'ENTRY D I $G(^XTMP("DGTMP",390.1,"ASTOP"))="YES" G OUT
38 .S OV=$P($G(@(GLOB_ENTRY_","_NODE_")")),"^",PIECE)
39 .S NV=$$GETNV(TYPE,OV)
40 .I NV'=-1,NV'=OV D
41 ..S DIE=GLOB,DA=ENTRY,DR=FIELD_"////^S X="""_$S(NV="":"@",1:NV)_"""" D ^DIE
42 ..I NV'="" S X=$P(^XTMP("DGTMP",390.2,$O(^XTMP("DGTMP",390.2,$S(TYPE=13:"AC",1:"AD"),OV,0)),0),"^",9),$P(^(0),"^",9)=X+1
43 ..Q
44 .S $P(^XTMP("DGTMP",390.1,TASK,0),"^",8)=ENTRY
45 .Q
46 S $P(^XTMP("DGTMP",390.1,TASK,0),"^",9)=$$NOW^XLFDT
47OUT Q
48GETNV(TYPE,VALUE) ;
49 NEW NV
50 I VALUE=0 Q ""
51 I VALUE="" Q -1
52 ;IF POINTS TO A INVALID VALUE SET TO NULL
53 I '$D(^DIC(TYPE,VALUE,0)) Q ""
54 ;IF POINTS TO A NEW ENTRY...IT WAS A BROKEN POINTER TO BEGIN WITH
55 I $P($G(^XTMP("DGTMP",390.2,+$O(^XTMP("DGTMP",390.2,$S(TYPE=13:"AC",1:"AD"),VALUE,0)),0)),"^",8)=1 Q ""
56 S NV=$P(^XTMP("DGTMP",390.2,$O(^XTMP("DGTMP",390.2,$S(TYPE=13:"AC",1:"AD"),VALUE,0)),0),"^",$S(TYPE=13:6,1:7))
57 I NV Q NV
58 Q VALUE
59CHK() ;IS CONVERSION NECESSARY?
60 FOR X=0:0 S X=$O(^XTMP("DGTMP",390.2,X)) Q:'X I $P(^XTMP("DGTMP",390.2,X,0),"^",8)!'$P(^(0),"^",3) Q
61 Q X>0
62CHK1(FILE) ;IS CONVERSION FOR A FILE NECESSARY?
63 FOR X=0:0 S X=$O(^XTMP("DGTMP",390.2,X)) Q:'X I $P(^XTMP("DGTMP",390.2,X,0),"^",2)=FILE I $P(^XTMP("DGTMP",390.2,X,0),"^",8)!'$P(^(0),"^",3) Q
64 Q X>0
65CHK2() ;ARE ALL THE NONSTANDARD ENTRIES MAPPED?
66 FOR X=0:0 S X=$O(^XTMP("DGTMP",390.2,X)) Q:'X I '$P(^XTMP("DGTMP",390.2,X,0),"^",3),$P(^(0),"^",6)="",$P(^(0),"^",7)="" Q
67 Q '(X>0)
68CHK3() ;DID THE CONVERSION RUN TO COMPLETION?
69 I '$$CHK() Q 1
70 FOR X=0:0 S X=$O(^XTMP("DGTMP",390.1,X)) Q:'X I '$P(^XTMP("DGTMP",390.1,X,0),"^",9) Q
71 Q '(X>0)
72JOB ;Start background job
73 NEW ZTIO,ZTDTH,ZTASK,ZTRTN,ZTDESC,DIR,DIRUT
74 I '$$CHK() W !!,"*** Conversion is not necessary! ***",!!,"Uninstalling patch..." D JOBKILL W "...done!" Q
75 I '$$CHK2() W !!,"*** Not all non-standard entries have been mapped...see DG172 options ***",! Q
76 L +^XTMP("DGTMP",390.1,"ASTOP"):1 E W !,"*** Job appears to already be running! ***",! Q
77 W ! D MESS^DG17204("CONV") W !
78 S DIR("A")="Are you sure you want to start the conversion process"
79 S DIR(0)="Y",DIR("B")="NO"
80 D ^DIR K DIR Q:$D(DIRUT)!'Y
81 L -^XTMP("DGTMP",390.1,"ASTOP")
82 S ^XTMP("DGTMP",390.1,"ASTOP")="NO"
83 S ZTIO="",ZTRTN="CONV^DG17202",ZTDESC="Marital/Religion File Conversion" D ^%ZTLOAD
84 I $D(ZTSK) W !,"*** Task #: "_ZTSK_" ***",!
85 S ZTREQ="@"
86 K ZTSK,Y
87 Q
88STOP ;Stop background job
89 NEW DIR,DIRUT
90 L +^XTMP("DGTMP",390.1,"ASTOP"):1 E D Q
91 .S DIR("A")="Are you sure you want to stop the background conversion process",DIR(0)="Y",DIR("B")="NO"
92 .D ^DIR K DIR Q:$D(DIRUT)!'Y
93 .S ^XTMP("DGTMP",390.1,"ASTOP")="YES"
94 .W !!,"*** Job will stop soon ***",! K Y
95 .Q
96 L -^XTMP("DGTMP",390.1,"ASTOP")
97 W !,"*** Conversion process is NOT running! ***",!
98 Q
99JOBKILL ;
100 NEW OPT,FILE,DA,DR,DIE,IDEL,NON,PI,ITEM
101 FOR NON=0:0 S NON=$O(^XTMP("DGTMP",390.2,NON)) Q:'NON I '$P(^(NON,0),"^",3) D
102 .S DIE=$P(^(0),"^",2),DA=$S(DIE=11:$P(^(0),"^",5),1:$P(^(0),"^",4)),DR=".01///@",DIE="^DIC("_DIE_"," D ^DIE
103 .Q
104 F FILE=390.1,390.2 S DIU="^XTMP(""DGTMP"","_FILE_",",DIU(0)="DT" D EN^DIU2
105 K DIU
106 S OPT="RGPR PRE-IMP MENU" S PI=$$FIND1^DIC(19,"","OX",OPT)
107 I PI D FIND^DIC(19,"",.01,"M","DG172 ") S ITEM="" F S ITEM=$O(^TMP("DILIST",$J,1,ITEM)) Q:ITEM="" S IDEL=$$DELETE^XPDMENU(OPT,$P(^TMP("DILIST",$J,1,ITEM),U))
108 S OPT="DG172" F S OPT=$O(^DIC(19,"B",OPT)) Q:$E(OPT,1,5)'="DG172" S DIE="^DIC(19,",DA=$O(^(OPT,0)),DR=".01///@",DIDEL=19 D ^DIE K DIDEL
109 Q
Note: See TracBrowser for help on using the repository browser.