| 1 | VWREGITS ;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 | ;*******************************************************************
|
|---|
| 27 | SAVE(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
|
|---|
| 49 | LDPT 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 | ;
|
|---|
| 71 | EXP ;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 | ;
|
|---|
| 85 | M ;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 | ;
|
|---|
| 104 | DC(XDATE) ;Convert DOB to internal
|
|---|
| 105 | N %DT,X
|
|---|
| 106 | S X=XDATE,%DT="T" D ^%DT
|
|---|
| 107 | Q Y
|
|---|
| 108 | ;
|
|---|
| 109 | INSUR ;Insurance/Billing
|
|---|
| 110 | Q
|
|---|
| 111 | ;
|
|---|
| 112 | K S DA=$P(^DPT(0),"^",3),DIK="^DPT(" D ^DIK
|
|---|
| 113 | S DIK="^AUPNPAT(" D ^DIK
|
|---|
| 114 | Q
|
|---|
| 115 | ;
|
|---|
