1 | VWREGITS ;Portland,OR/jeb et al Save utility for VWREG* routines 11/2015 |
---|
2 | ;V.2;;**LOCAL**;;;Build 3 |
---|
3 | ;License: See License.txt that with install |
---|
4 | ;No fall thru - jeb |
---|
5 | Q |
---|
6 | ; |
---|
7 | ;* ***************************************************************** |
---|
8 | ;* Data coming in may be for a new case or existing case * |
---|
9 | ;* Incoming: Array LDATA= * |
---|
10 | ;* LDATA(1)=Field^Field number^value^[optional]DFN * |
---|
11 | ;* LDATA(N...)=Field^Field number^value * |
---|
12 | ;* Exception for Multiples: * |
---|
13 | ;* LDATA(N)=Field(SUBDD;Field number):value(IEN)^...etc for every* |
---|
14 | ;* field that is a dependent of the parent * |
---|
15 | ;* Process: * |
---|
16 | ;* 1. call is at Label SAVE * |
---|
17 | ;* 2. Some housekeeping that this programmer needs to do proper * |
---|
18 | ;* string evaluations. * |
---|
19 | ;* 3. Filing of a new case with FILE^DICN. * |
---|
20 | ;* 4. Remaining major fields are filed with DIE * |
---|
21 | ;* 5. Multiples are filed with UPDATE^DIE * |
---|
22 | ;* 6. Existing entries will contain only edited data and will * |
---|
23 | ;* address those fields as in 4 & 5. * |
---|
24 | ;* Bon Appettit, et al. * |
---|
25 | ;******************************************************************* |
---|
26 | SAVE(RESULT,LDATA) ; |
---|
27 | K RESULT,^DIZ("DS",$J) |
---|
28 | M ^DIZ("DS",$J)=LDATA |
---|
29 | ;Q ;Testing |
---|
30 | N DFN,DIC,DA,DR,VAR,FIELD,N,N1,X,Y,DIE,DIK |
---|
31 | I $D(LDATA)<10 S RESULT(0)="-1: No data sent for filing. Please contact your IT dept." Q |
---|
32 | ;UPcase everyTHING |
---|
33 | S XDAT="LDATA" F S XDAT=$Q(@XDAT) Q:XDAT="" S @XDAT=$$UP^XLFSTR(@XDAT) |
---|
34 | ; |
---|
35 | ;Incoming housekeeping |
---|
36 | S X="LDATA" F I=1:1 S X=$Q(@X) Q:X="" I @X[":",@X[";" S ^DIZ("DS",$J,I)=@X K @X |
---|
37 | I +$P(@$Q(LDATA),"^",4)!(+$P(@$Q(LDATA),"(",2)) G EXP ;DFN sent by client |
---|
38 | S N=0 F S N=$O(LDATA(N)) Q:'+N I +$P($G(^DD(2,+$P(LDATA(N),"^",2),0)),"^",2) K LDATA(N) |
---|
39 | S DFN=$$FIND1^DIC(2,"","M",$P(LDATA(1),"^",3),"","","ERR") |
---|
40 | G EXP:DFN ;Found patient/client |
---|
41 | ;End housekeeping; |
---|
42 | ; |
---|
43 | S X=$P(LDATA(1),"^",3) D |
---|
44 | . S DIC="^DPT(",DIC(0)="LZ" K D0 D FILE^DICN S (DA,DFN)=+Y |
---|
45 | . S DIC="^AUPNPAT(",DIC(0)="LZ",X=DFN,DINUM=X,DIC(0)="L" D FILE^DICN |
---|
46 | . S DIE=DIC,DR=.03_"////^S X=DT" D ^DIE |
---|
47 | . S DR=.11_"////^S X=DUZ" D ^DIE |
---|
48 | LDPT L +^DPT(DFN):1 G LDPT:'$T |
---|
49 | S N=1 F S N=$O(LDATA(N)) Q:'+N D |
---|
50 | . Q:$P(LDATA(N),"^",2)[";" |
---|
51 | . Q:'+$P(LDATA(N),"^",2) ;Marker of some kind |
---|
52 | . S FIELD=$P(LDATA(N),"^",2) |
---|
53 | . S VAR=$P(LDATA(N),"^",3) |
---|
54 | . I FIELD=.03 D |
---|
55 | .. S VAR=$$DC(VAR) |
---|
56 | .. S VARTIME=$P(VAR,".",2),VAR=$P(VAR,".") |
---|
57 | .. I $L(VARTIME) D |
---|
58 | ... N FDA |
---|
59 | ... S FDA(2,DFN_",",540000.1)=VARTIME |
---|
60 | ... D FILE^DIE("E","FDA") |
---|
61 | ... D CLEAN^DILF |
---|
62 | . S:VAR["(" VAR=$S($L(VAR,"(")>2:+$P(VAR,"(",$L(VAR,"(")),1:+$P(VAR,"(",2)) |
---|
63 | . S DIE="^DPT(",DR=FIELD_"///"_$S(+VAR:"/",1:"")_"^S X=VAR" D ^DIE |
---|
64 | L -^DPT(DFN) |
---|
65 | D M ;File any multiple fields |
---|
66 | S RESULT(0)="Filed..." |
---|
67 | ;K ^DIZ("DS",$J) |
---|
68 | Q |
---|
69 | ; |
---|
70 | EXP ;Existing Patient |
---|
71 | K X,FNAME,FFLD,FVALUE,AR,DIC,DA,DR,DIE,AR |
---|
72 | S X="LDATA" F S X=$Q(@X) Q:X="" I @X[":" S AR($O(AR(" "),-1)+1)=@X K @X |
---|
73 | S N=0 F S N=$O(LDATA(N)) Q:'+N S X=LDATA(N) D |
---|
74 | . S FNAME=$P(X,"^") |
---|
75 | . S FFLD=$P(X,"^",2) |
---|
76 | . S FVALUE=$S($P(X,"^",3)["(":+$P(X,"(",2),1:$P(X,"^",3)) |
---|
77 | . S DFN=$P(X,"^",4) |
---|
78 | . S DIE="^DPT(",DA=DFN,DR=FFLD_"///^S X=FVALUE" D ^DIE |
---|
79 | D M |
---|
80 | S RESULT($I(RESULT))="Filed..." |
---|
81 | K X,FNAME,FFL,FVALUE,DFN,AR,DIE,DA,DR,DIC |
---|
82 | Q |
---|
83 | ; |
---|
84 | M ;File any multiples values; DFN should be defined above |
---|
85 | Q:'$D(^DIZ("DS",$J)) |
---|
86 | M MULTS=^DIZ("DS",$J) |
---|
87 | K MAR S N=0 F S N=$O(MULTS(N)) Q:'+N D |
---|
88 | . F J=1:1:$L(MULTS(N),"^")-1 S MAR(J)=$P(MULTS(N),"^",J) |
---|
89 | . S MX=$O(MAR(0)) |
---|
90 | . S MXFILE=+$P(MAR(MX),"(",2) |
---|
91 | . S MXFLD=+$P(MAR(MX),";",2) |
---|
92 | . S MXVAL=$P($P(MAR(MX),":",2),"(") |
---|
93 | . I MXFLD=.01 S MXDATA(MXFILE,"?+1,"_DFN_",",MXFLD)=MXVAL K IEN D UPDATE^DIE("E","MXDATA","IEN","ERROR") Q:$G(DIERR) D |
---|
94 | .. S RECORD=$G(IEN(1)),INC=$G(IEN(1,0)) |
---|
95 | .. S J=MX F S J=$O(MAR(J)) Q:'+J D |
---|
96 | ... s MXFILE=+$P(MAR(J),"(",2) |
---|
97 | ... S MXFLD=+$P(MAR(J),";",2) |
---|
98 | ... S MXVAL=$P(MAR(J),":",2),MXVAL=$S(MXVAL["(":$P(MXVAL,"("),1:MXVAL) |
---|
99 | ... S MXDATA(MXFILE,$S(MXFLD=.01:INC,1:"")_"1,"_RECORD_","_DFN_",",MXFLD)=MXVAL |
---|
100 | ... K IEN,ERROR D UPDATE^DIE("E","MXDATA","IEN","ERROR") |
---|
101 | Q |
---|
102 | ; |
---|
103 | DC(XDATE) ;Convert DOB to internal |
---|
104 | N %DT,X |
---|
105 | S X=XDATE,%DT="T" D ^%DT |
---|
106 | Q Y |
---|
107 | ; |
---|
108 | INSUR ;Insurance/Billing |
---|
109 | Q |
---|
110 | ; |
---|
111 | K S DA=$P(^DPT(0),"^",3),DIK="^DPT(" D ^DIK |
---|
112 | S DIK="^AUPNPAT(" D ^DIK |
---|
113 | Q |
---|
114 | ; |
---|