110 lines
5.3 KiB
Mathematica
110 lines
5.3 KiB
Mathematica
SDPHARM1 ;BIRMINGHAM OIFO/RON - Determine default Institution/Station no. ; 8/9/03
|
|
;;5.3;Scheduling;**300,314,318**;AUG 13, 1993
|
|
;
|
|
DEF(SDPSODFN) ;Pass in Patient
|
|
I '$G(SDPSODFN)!('$D(^DPT(SDPSODFN,0))) Q 0
|
|
N DA,DR,DIC,DIE,DIQ,X,Y,SDPSODSS,SDPSOPRM,SDPSODFA,SDPSODF1,SDPSODF2,SDPSODF3,SDPSOPDF
|
|
D INIT
|
|
D PAT
|
|
I '$D(SDPSODFA) Q 0
|
|
S (SDPSOPRM,SDPSOPDF)=0
|
|
S SDPSODF1="" F S SDPSODF1=$O(SDPSODFA(SDPSODF1)) Q:SDPSODF1=""!(SDPSOPRM) S SDPSODF2="" F S SDPSODF2=$O(SDPSODFA(SDPSODF1,SDPSODF2)) Q:SDPSODF2=""!(SDPSOPRM) D
|
|
.S SDPSODF3="" F S SDPSODF3=$O(SDPSODFA(SDPSODF1,SDPSODF2,SDPSODF3)) Q:SDPSODF3=""!(SDPSOPRM) D
|
|
..I SDPSODFA(SDPSODF1,SDPSODF2,SDPSODF3) S SDPSOPDF=SDPSODF2_"^"_SDPSODF3,SDPSOPRM=1 Q
|
|
..S SDPSOPDF=SDPSODF2_"^"_SDPSODF3
|
|
Q $S(SDPSOPDF:SDPSOPDF,1:0)
|
|
INIT ;Initialize variables
|
|
;Create primary care DSS credit pair array
|
|
N SDPSODI,SDPSODII
|
|
F SDPSODI=322,323,350 F SDPSODII="000",185,186,187 S SDPSODSS(SDPSODI_SDPSODII)=""
|
|
Q
|
|
;
|
|
PAT ;
|
|
N SDPSOSTA,SDPSOATZ,SDPSODIV,SDPSODCP,SDPSOCL0,SDPSOAP0,SDPSOSDT,SDPSOOUT,X,Y,X1,X2
|
|
S SDPSOOUT=0
|
|
I '$G(DT) S DT=$$DT^XLFDT
|
|
;S X1=DT,X2=-1 D C^%DTC S SDPSOSDT=X_".2359"
|
|
;Call scheduling API for appointment information
|
|
N SDPSOCNT,SDPSOSDI
|
|
K ^TMP($J,"SDAMA201","GETAPPT")
|
|
D GETAPPT^SDAMA201(SDPSODFN,"1;2","R",DT,,.SDPSOCNT)
|
|
I $G(SDPSOCNT)>0 D
|
|
.F SDPSOSDI=1:1:SDPSOCNT S SDPSOAP0=+$G(^TMP($J,"SDAMA201","GETAPPT",SDPSOSDI,2)) D
|
|
..;Q:$P(SDPSOAP0,U,2)["C" ;Skip cancelled appointments
|
|
..S SDPSOCL0=$G(^SC(+SDPSOAP0,0)) Q:'$L(SDPSOCL0) ;Get clinic 0 node
|
|
..S SDPSODCP=$$CPAIR(SDPSOCL0) ;Get DSS credit pair
|
|
..S SDPSODIV=$$DIV(SDPSOCL0) ;Get clinic division
|
|
..K SDPSOSTA I $G(SDPSODIV) K SDPSOATZ,DIC,DIQ,DD,DR S DIC=4,DR="99",DA=+SDPSODIV,DIQ(0)="I",DIQ="SDPSOATZ" D EN^DIQ1 S SDPSOSTA=$G(SDPSOATZ(4,+SDPSODIV,99,"I")) K DIC,DIQ,DR,DA,SDPSOATZ
|
|
..I SDPSODIV>0,$G(SDPSOSTA)'="" D
|
|
...S SDPSOSDT=$P($G(^TMP($J,"SDAMA201","GETAPPT",SDPSOSDI,1)),"^") I SDPSOSDT D
|
|
....S SDPSODFA(SDPSOSDT,SDPSODIV,SDPSOSTA)=$S($D(SDPSODSS(SDPSODCP)):1,1:0)
|
|
K ^TMP($J,"SDAMA201","GETAPPT")
|
|
Q
|
|
;
|
|
CPAIR(SDPSOCL0) ;Get credit pair
|
|
N SDPSOSDX
|
|
S SDPSOSDX=$P($G(^DIC(40.7,+$P(SDPSOCL0,U,7),0)),U,2)
|
|
S SDPSOSDX=SDPSOSDX_$P($G(^DIC(40.7,+$P(SDPSOCL0,U,18),0)),U,2)
|
|
S SDPSOSDX=$E(SDPSOSDX_"000000",1,6)
|
|
Q SDPSOSDX
|
|
;
|
|
DIV(SDPSOCL0) ;Get facility division name and number
|
|
N SDPSODVX,SDPSOHLD S SDPSODVX=$P(SDPSOCL0,U,15)
|
|
S SDPSOHLD=0
|
|
I SDPSODVX>0 S SDPSOHLD=$P($$SITE^VASITE(,SDPSODVX),U)
|
|
I SDPSOHLD>0 Q SDPSOHLD
|
|
S SDPSOHLD=$P(SDPSOCL0,"^",4)
|
|
I 'SDPSOHLD Q 0
|
|
I SDPSOHLD K ^UTILITY("DIQ1",$J),DIQ S DA=SDPSOHLD,DIC=4,DIQ(0)="E",DR=".01" D EN^DIQ1 S:$G(^UTILITY("DIQ1",$J,4,DA,.01,"E"))="" SDPSOHLD=0 K ^UTILITY("DIQ1",$J),DA,DR,DIC,DIQ
|
|
Q SDPSOHLD
|
|
;
|
|
PRIAPT(SDPSOPAT) ;Find nearest Primary care appt, past or future
|
|
I '$G(DT) S DT=$$DT^XLFDT
|
|
I '$G(SDPSOPAT) Q ""
|
|
N SDPSODSS,X1,X2,X,Y
|
|
D INIT
|
|
N SDPSOQEC,SDPSOX,SDPSOX1,SDPSOX2,SDPSOX3,SDPSOX4,SDPSOX5,SDPSOX6,SDPSOX7,SDPSOX8,SDPSOX9,SDPSOX10,SDPSOX11,SDPSOX12,SDPSOX13,SDPSOX14,SDPSOX15
|
|
S SDPSOX=" "
|
|
S SDPSOQEC=0
|
|
F S SDPSOX=$O(^SCE("ADFN",SDPSOPAT,SDPSOX),-1),SDPSOX1=0 Q:'SDPSOX!(SDPSOQEC)!(SDPSOX<3030725) F S SDPSOX1=$O(^SCE("ADFN",SDPSOPAT,SDPSOX,SDPSOX1)) Q:'SDPSOX1!(SDPSOQEC) D
|
|
.S SDPSOX2=$G(^SCE(SDPSOX1,0)) Q:'$L(SDPSOX2)
|
|
.Q:$P(SDPSOX2,"^",6)
|
|
.Q:'$P(SDPSOX2,"^",4)
|
|
.;next line, checking for only "CHECKED OUT" and INPATIENT encounters
|
|
.I $P(SDPSOX2,"^",12)'=2,$P(SDPSOX2,"^",12)'=8 Q
|
|
.S SDPSOX3=$G(^SC(+$P(SDPSOX2,"^",4),0)) Q:'$L(SDPSOX3)
|
|
.S SDPSOX4=$$CPAIR(SDPSOX3)
|
|
.Q:'$D(SDPSODSS(SDPSOX4))
|
|
.S SDPSOX5(SDPSOPAT,"ENC")=SDPSOX_"^"_+$P(SDPSOX2,"^",4),SDPSOQEC=1
|
|
;S X1=DT,X2=-1 D C^%DTC S SDPSOX6=X_.2359
|
|
N SDPSOCOU,SDPSODSI
|
|
K ^TMP($J,"SDAMA201","GETAPPT")
|
|
D GETAPPT^SDAMA201(SDPSOPAT,"1;2","R",DT,,.SDPSOCOU)
|
|
I $G(SDPSOCOU)>0 D
|
|
.F SDPSODSI=1:1:SDPSOCOU S SDPSOX7=+$G(^TMP($J,"SDAMA201","GETAPPT",SDPSODSI,2)) Q:$D(SDPSOX10(SDPSOPAT,"APP")) D
|
|
..;Q:$P(SDPSOX7,"^",2)["C"
|
|
..S SDPSOX8=$G(^SC(+SDPSOX7,0)) Q:'$L(SDPSOX8)
|
|
..S SDPSOX9=$$CPAIR(SDPSOX8)
|
|
..Q:'$D(SDPSODSS(SDPSOX9))
|
|
..S SDPSOX6=$P($G(^TMP($J,"SDAMA201","GETAPPT",SDPSODSI,1)),"^")
|
|
..I '$D(SDPSOX10(SDPSOPAT,"APP")) S SDPSOX10(SDPSOPAT,"APP")=SDPSOX6_"^"_+SDPSOX7 Q
|
|
..I SDPSOX6<$P($G(SDPSOX10(SDPSOPAT,"APP")),"^") S SDPSOX10(SDPSOPAT,"APP")=SDPSOX6_"^"_+SDPSOX7
|
|
K ^TMP($J,"SDAMA201","GETAPPT")
|
|
I '$D(SDPSOX10(SDPSOPAT,"APP")),'$D(SDPSOX5(SDPSOPAT,"ENC")) Q ""
|
|
I $D(SDPSOX10(SDPSOPAT,"APP")),'$D(SDPSOX5(SDPSOPAT,"ENC")) D APPX Q SDPSOX11
|
|
I $D(SDPSOX5(SDPSOPAT,"ENC")),'$D(SDPSOX10(SDPSOPAT,"APP")) D APPE Q SDPSOX11
|
|
S SDPSOX12=$P(SDPSOX10(SDPSOPAT,"APP"),"^"),SDPSOX14=$$FMDIFF^XLFDT(SDPSOX12,DT,1)
|
|
S SDPSOX12=$P(SDPSOX5(SDPSOPAT,"ENC"),"^") S:SDPSOX12<0 SDPSOX12=$E(SDPSOX12,2,$L(SDPSOX12)) S SDPSOX15=$$FMDIFF^XLFDT(DT,SDPSOX12,1)
|
|
;Encounter wins ties
|
|
I SDPSOX14=SDPSOX15 D APPE Q SDPSOX11
|
|
I SDPSOX15>SDPSOX14 D APPX Q SDPSOX11
|
|
D APPE Q SDPSOX11
|
|
APPX ;
|
|
S Y=$P(SDPSOX10(SDPSOPAT,"APP"),"^") D DD^%DT S SDPSOX11=Y_" "_$P($G(^SC(+$P($G(SDPSOX10(SDPSOPAT,"APP")),"^",2),0)),"^")
|
|
S SDPSOX12=$P(SDPSOX10(SDPSOPAT,"APP"),"^") S SDPSOX13=$$FMDIFF^XLFDT(SDPSOX12,DT,1) S SDPSOX11=SDPSOX11_" ("_SDPSOX13_" days)"
|
|
Q
|
|
APPE ;
|
|
S Y=$P(SDPSOX5(SDPSOPAT,"ENC"),"^") D DD^%DT S SDPSOX11=Y_" "_$P($G(^SC(+$P($G(SDPSOX5(SDPSOPAT,"ENC")),"^",2),0)),"^")
|
|
S SDPSOX12=$P(SDPSOX5(SDPSOPAT,"ENC"),"^") S SDPSOX13=$$FMDIFF^XLFDT(SDPSOX12,DT,1) S SDPSOX11=SDPSOX11_" ("_SDPSOX13_" days)"
|
|
Q
|