122 lines
6.4 KiB
Mathematica
122 lines
6.4 KiB
Mathematica
IBDFUTL1 ;ALB/MAF - Maintenance Utility cont. - 4 20 95
|
|
;;3.0;AUTOMATED INFO COLLECTION SYS;**32,23,51**;APR 24, 1997
|
|
;
|
|
;
|
|
SETSTR(S,V,X,L) ; -- insert text(S) into variable(V)
|
|
; S := string
|
|
; V := destination
|
|
; X := @ col X
|
|
; L := # of chars
|
|
;
|
|
Q $E(V_$J("",X-1),1,X-1)_$E(S_$J("",L),1,L)_$E(V,X+L,999)
|
|
;
|
|
;
|
|
SETARR ; -- Set up Listman array
|
|
S IBDCNT1=IBDCNT1+1
|
|
S IBDCNT=IBDCNT+1,VALMCNT=VALMCNT+1
|
|
S X=""
|
|
S IBDFVAL=$J(IBDCNT1_")",5)
|
|
S X=$$SETSTR^VALM1(IBDFVAL,X,1,5)
|
|
S IBDFVAL=IBDFX
|
|
S X=$$SETSTR^VALM1(IBDFVAL,X,7,8)
|
|
S IBDFVAL=$P(IBDFTMP,"^",3)
|
|
S X=$$SETSTR^VALM1(IBDFVAL,X,17,15)
|
|
S IBDFVAL=$P(^IBE(357.1,IBDFBLK,0),"^",1)
|
|
S X=$$SETSTR^VALM1(IBDFVAL,X,34,14)
|
|
S IBDFVAL=$P(^IBE(357,IBDFORM1,0),"^",1)
|
|
S X=$$SETSTR^VALM1(IBDFVAL,X,50,14)
|
|
I $D(VAUTC)!($D(VAUTG)) S IBDFVAL=$P(IBDFTMP,"^",6) S X=$$SETSTR^VALM1(IBDFVAL,X,66,14)
|
|
;
|
|
;
|
|
TMP ; -- Set up TMP Array
|
|
S ^TMP("CPT",$J,IBDCNT,0)=$$LOWER^VALM1(X),^TMP("CPT",$J,"IDX",VALMCNT,IBDCNT1)=""
|
|
S ^TMP("CPTIDX",$J,IBDCNT1)=VALMCNT_"^"_IBDFX_"^"_$P(IBDFTMP,"^",4)_"^"_$P(IBDFTMP,"^",5)_"^"_$P(IBDFTMP,"^",1)_"^"_$P(IBDFTMP,"^",2)
|
|
Q
|
|
SETARR1 ; -- Set up Listman array
|
|
N IBDPRIM,IBDSELP
|
|
S IBDSELP=$P($G(IBDFTMP),"^",5)
|
|
Q:IBDSELP']""
|
|
S IBDPRIM=$P($G(^IBE(357.3,IBDSELP,0)),"^")
|
|
I IBDPRIM=IBDFX Q
|
|
;S IBDCNT1=IBDCNT1+1
|
|
S IBDCNT=IBDCNT+1,VALMCNT=VALMCNT+1
|
|
S X=""
|
|
S IBDFVAL="Primary Diagnosis: "_IBDPRIM
|
|
S X=$$SETSTR^VALM1(IBDFVAL,X,17,40)
|
|
;
|
|
;
|
|
TMP1 ; -- Set up TMP Array
|
|
S ^TMP("CPT",$J,IBDCNT,0)=$$LOWER^VALM1(X),^TMP("CPT",$J,"IDX",VALMCNT,IBDCNT1)=""
|
|
Q
|
|
;
|
|
;
|
|
SET ; -- Loop thru to see if codes are valid
|
|
F IBDFBLK=0:0 S IBDFBLK=$O(^IBE(357.1,"C",IBDFORM,IBDFBLK)) Q:'IBDFBLK D
|
|
.F IBDFLST=0:0 S IBDFLST=$O(^IBE(357.2,"C",IBDFBLK,IBDFLST)) Q:'IBDFLST S IBDFNODE=$G(^IBE(357.2,IBDFLST,0)) I $P(IBDFNODE,"^",11)=IBDFINT D
|
|
..F IBDFSEL=0:0 S IBDFSEL=$O(^IBE(357.3,"C",IBDFLST,IBDFSEL)) Q:'IBDFSEL S IBDFX=$G(^IBE(357.3,IBDFSEL,0)) I $P(IBDFX,"^",2)']"" D
|
|
...S IBDFX1=$P(IBDFX,"^",1),IBDFX2=$P($G(^IBE(357.3,IBDFSEL,2)),"^",3),IBDFX3=$P($G(^IBE(357.3,IBDFSEL,2)),"^",4)
|
|
...F IBI=IBDFX1,IBDFX2,IBDFX3 I IBI]"" D
|
|
....I IBDFACT=1 D
|
|
.....S (X,IBDFX)=IBI
|
|
.....X $G(^IBE(357.6,IBDFINT,11))
|
|
.....Q:'$D(X)
|
|
.....;;----change to api cpt;dhh
|
|
.....I $G(IBDFCODE)="CPT " N IBY,XX D
|
|
......S XX=$$CPT^ICPTCOD(X)
|
|
......;;S IBY=$S(+XX=-1:"",1:$P(XX,"^",3))
|
|
......S IBY=$S($P(XX,U,7)'=1:"",1:$P(XX,"^",3))
|
|
.....;;I $G(IBDFCODE)="ICD-9 " N IBY S IBY=$P($G(^ICD9(X,0)),"^",3)
|
|
.....I $G(IBDFCODE)="ICD-9 " N IBY S IBY=$P($$ICDDX^ICDCODE(X),U,4)
|
|
.....I $G(IBDFCODE)="Type of Visit " N IBY S IBY=$P($G(^IBE(357.69,X,0)),"^",2)
|
|
.....Q:'$D(VAUTJ(X))
|
|
.....S ^TMP("UTIL",$J,IBDFNAME,IBDFX,$P(^IBE(357,IBDFORM,0),"^",1),$P(^IBE(357.1,IBDFBLK,0),"^",1),IBDFSEL)=IBDFORM_"^"_IBDFBLK_"^"_$S(IBY]"":IBY,1:"INVALID")_"^"_IBDFLST_"^"_IBDFSEL_"^"_$S($D(VAUTC):IBDFNAME,$D(VAUTG):IBDFCLNM,1:"")
|
|
....I IBDFACT=2 D
|
|
.....S (X,IBDFX)=IBI
|
|
.....X $G(^IBE(357.6,IBDFINT,11))
|
|
.....I '$D(X) S ^TMP("UTIL",$J,IBDFNAME,IBDFX,$P(^IBE(357,IBDFORM,0),"^",1),$P(^IBE(357.1,IBDFBLK,0),"^",1),IBDFSEL)=IBDFORM_"^"_IBDFBLK_"^"_$S(Y]"":Y,1:"INVALID")_"^"_IBDFLST_"^"_IBDFSEL_"^"_$S($D(VAUTC):IBDFNAME,$D(VAUTG):IBDFCLNM,1:"")
|
|
Q
|
|
;
|
|
;
|
|
; -- Set up alphabetical listing
|
|
SET1 S (IBDFORM1,IBDFBLK,IBDFLG,IBDFX,IBDFNAME,IBDORM,IBDBLK)=0
|
|
F IBDFNM=0:0 S IBDFNAME=$O(^TMP("UTIL",$J,IBDFNAME)) Q:IBDFNAME']"" S IBDFX="" F S IBDFX=$O(^TMP("UTIL",$J,IBDFNAME,IBDFX)) D:(IBDFX="")&($D(VAUTF)) CLINICS^IBDFUTL2 Q:IBDFX="" D
|
|
.F IBDFRM=0:0 S IBDORM=$O(^TMP("UTIL",$J,IBDFNAME,IBDFX,IBDORM)) Q:IBDORM']"" F IBDFBK=0:0 S IBDBLK=$O(^TMP("UTIL",$J,IBDFNAME,IBDFX,IBDORM,IBDBLK)) Q:IBDBLK']"" D
|
|
..F S IBDFSEL=$O(^TMP("UTIL",$J,IBDFNAME,IBDFX,IBDORM,IBDBLK,IBDFSEL)) Q:IBDFSEL']"" D
|
|
...S IBDFTMP=^TMP("UTIL",$J,IBDFNAME,IBDFX,IBDORM,IBDBLK,IBDFSEL),IBDFORM1=$P(IBDFTMP,"^",1),IBDFBLK=$P(IBDFTMP,"^",2) D:'$D(IBDF(IBDFNAME)) HEADER^IBDFUTL2 D SETARR D:IBDBLK="DIAGNOSIS" SETARR1
|
|
Q
|
|
;
|
|
;
|
|
CLIN1 ; -- Sort Display by clinic
|
|
N IBDFBLK,IBDFLST,IBDFORM,VAUTF
|
|
I VAUTC=1 F X=0:0 S X=$O(^SC(X)) Q:'X I $D(^SC(X,0)) S ^TMP("CLN",$J,X)=$P(^SC(X,0),"^",1)
|
|
I VAUTC=0 K ^TMP("CLN",$J) F IBDFCLIN=0:0 S IBDFCLIN=$O(VAUTC(IBDFCLIN)) Q:'IBDFCLIN S X=$G(VAUTC(IBDFCLIN)) S ^TMP("CLN",$J,IBDFCLIN)=X
|
|
I '$D(IBDFNCNG) K ^TMP("CLN1",$J)
|
|
F IBDFCLIN=0:0 S IBDFCLIN=$O(^TMP("CLN",$J,IBDFCLIN)) Q:'IBDFCLIN S X=$G(^TMP("CLN",$J,IBDFCLIN)) S ^TMP("CLN1",$J,X)=IBDFCLIN
|
|
S IBDCLNM=0 F IBDCLN=0:0 S IBDCLNM=$O(^TMP("CLN1",$J,IBDCLNM)) Q:IBDCLNM']"" S IBDFCLIN=^TMP("CLN1",$J,IBDCLNM) S IBDFCIFN=$O(^SD(409.95,"B",IBDFCLIN,0)) S IBDCNODE=$G(^SD(409.95,+IBDFCIFN,0)),IBDFNAME=IBDCLNM I $D(IBDCNODE) D
|
|
.F IBDFN=2:1:9 S IBDFORM=$P(IBDCNODE,"^",IBDFN) I IBDFORM D SET
|
|
D SET1 Q
|
|
;
|
|
;
|
|
FORM1 ; -- Sort Display by form
|
|
N IBDFBLK,IBDFLST,IBDFORM
|
|
I VAUTF=1 S IBDFRNM=0 F IBDFRM=0:0 S IBDFRNM=$O(^IBE(357,"B",IBDFRNM)) Q:IBDFRNM']"" F IBDFORM=0:0 S IBDFORM=$O(^IBE(357,"B",IBDFRNM,IBDFORM)) Q:'IBDFORM S IBDFNAME=IBDFRNM D SET
|
|
I '$D(IBDFNCNG) K ^TMP("FRM1",$J)
|
|
I VAUTF=0 F IBDFORM=0:0 S IBDFORM=$O(VAUTF(IBDFORM)) Q:'IBDFORM S X=$G(VAUTF(IBDFORM)) S ^TMP("FRM1",$J,X)=IBDFORM
|
|
I VAUTF=0 S IBDFRNM=0 F IBDFRM=0:0 S IBDFRNM=$O(^TMP("FRM1",$J,IBDFRNM)) Q:IBDFRNM']"" S IBDFORM=^TMP("FRM1",$J,IBDFRNM),IBDFNAME=IBDFRNM D SET
|
|
D SET1
|
|
Q
|
|
;
|
|
;
|
|
GROUP1 ; -- Sort Display by clinic group
|
|
N IBDFBLK,IBDFLST,IBDFORM,VAUTF
|
|
I VAUTG=1 S IBDFGNM=0 F IBDFGN=0:0 S IBDFGNM=$O(^IBD(357.99,"B",IBDFGNM)) Q:IBDFGNM']"" F IBDFGIFN=0:0 S IBDFGIFN=$O(^IBD(357.99,"B",IBDFGNM,IBDFGIFN)) Q:'IBDFGIFN S ^TMP("GRP1",$J,IBDFGNM)=IBDFGIFN
|
|
I VAUTG=0,'$D(IBDFNCNG) K ^TMP("GRP1",$J)
|
|
I VAUTG=0 F IBDFGIFN=0:0 S IBDFGIFN=$O(VAUTG(IBDFGIFN)) Q:'IBDFGIFN S ^TMP("GRP1",$J,VAUTG(IBDFGIFN))=IBDFGIFN
|
|
S IBDFGNM=0 F IBDFGN=0:0 S IBDFGNM=$O(^TMP("GRP1",$J,IBDFGNM)) Q:IBDFGNM']"" S IBDFGIFN=^TMP("GRP1",$J,IBDFGNM) D
|
|
.S IEN=0 F S IEN=$O(^IBD(357.99,IBDFGIFN,10,IEN)) Q:'IEN S IBCLN=+$G(^IBD(357.99,IBDFGIFN,10,IEN,0)) S:$D(^SC(IBCLN,0)) ^TMP("IBDF",$J,"C",IBDFGNM,$P(^SC(IBCLN,0),"^",1))=IBCLN
|
|
.S IEN=0 F S IEN=$O(^IBD(357.99,IBDFGIFN,11,IEN)) Q:'IEN S IBDIV=+$G(^IBD(357.99,IBDFGIFN,11,IEN,0)) S:IBDIV ^TMP("IBDF",$J,"D",IBDFGNM,IBDIV)=""
|
|
D:$D(^TMP("IBDF",$J,"D")) ENDV^IBDFUTL2
|
|
S IBDFGNM=0 F IBDFGN=0:0 S IBDFGNM=$O(^TMP("IBDF",$J,"C",IBDFGNM)) Q:IBDFGNM']"" S IBDFCLNM=0 F IBDFCLN=0:0 S IBDFCLNM=$O(^TMP("IBDF",$J,"C",IBDFGNM,IBDFCLNM)) Q:IBDFCLNM']"" D
|
|
.S IBDFCLIN=$G(^TMP("IBDF",$J,"C",IBDFGNM,IBDFCLNM)),IBDFCIFN=$O(^SD(409.95,"B",IBDFCLIN,0)) S IBDCNODE=$G(^SD(409.95,+IBDFCIFN,0)) I $D(IBDCNODE) S IBDFNAME=IBDFGNM F IBDFN=2:1:9 S IBDFORM=$P(IBDCNODE,"^",IBDFN) I IBDFORM D SET
|
|
D SET1 Q
|