source: VWGUIRegistration/trunk/VWREGITS.m@ 1798

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