115 lines
4.9 KiB
Mathematica
115 lines
4.9 KiB
Mathematica
SDWLCU5 ;IOFO BAY PINES/TEH - EWL FILE 409.3 CLEANUP ;2/4/03
|
|
;;5.3;scheduling;**280,427**;AUG 13 1993
|
|
EN ;
|
|
W !!,"Checking file 404.51 one last time.",!
|
|
S SDWLERR="",TEAM=0 F S TEAM=$O(^SCTM(404.51,TEAM)) Q:'TEAM D Q:SDWLERR=1
|
|
. S INST=$$GET1^DIQ(404.51,TEAM_",",.07,"I")
|
|
. S CODE=$$GET1^DIQ(4,INST_",",11,"I")
|
|
. S INCK=$$TF^XUAF4(INST)
|
|
. I CODE'="N"!('INCK) D
|
|
.. W !!,"TEAM: ",$$GET1^DIQ(404.51,TEAM_",",.01)," INSTITUTION: "
|
|
.. W $$GET1^DIQ(4,INST_",",.01)
|
|
.. D EDIT^SDWLCU2
|
|
Q:SDWLERR=1
|
|
;
|
|
W !!,"Checking file 409.31 one last time.",!
|
|
40931 S SDWLSS=0 F S SDWLSS=$O(^SDWL(409.31,SDWLSS)) Q:'SDWLSS D Q:SDWLERR=1
|
|
. S SDWLINS="" F S SDWLINS=$O(^SDWL(409.31,SDWLSS,"I","B",SDWLINS)) Q:'SDWLINS D Q:SDWLERR=1
|
|
.. S CODE=$$GET1^DIQ(4,SDWLINS_",",11,"I")
|
|
.. S INCK=$$TF^XUAF4(SDWLINS)
|
|
.. I CODE'="N"!('INCK) D
|
|
... W !!,"SERVICE SPECIALTY: ",$$GET1^DIQ(409.31,SDWLSS_",",.01)," INSTITUTION: "
|
|
... W $$GET1^DIQ(4,SDWLINS_",",.01)
|
|
... D GETINS Q:SDWLERR=1
|
|
... S SDWLSSX="" F S SDWLSSX=$O(^SDWL(409.31,SDWLSS,"I","B",SDWLINS,SDWLSSX)) Q:'SDWLSSX D Q:SDWLERR=1
|
|
.... D C3^SDWLCU3
|
|
Q:SDWLERR=1
|
|
40932 W !!,"Checking file 409.32 one last time.",!
|
|
S SDWLSC=0 F S SDWLSC=$O(^SDWL(409.32,SDWLSC)) Q:'SDWLSC D Q:SDWLERR=1
|
|
. S SDWLINS=$$GET1^DIQ(409.32,SDWLSC_",",.02,"I")
|
|
. S CODE=$$GET1^DIQ(4,SDWLINS_",",11,"I")
|
|
. S INCK=$$TF^XUAF4(SDWLINS)
|
|
. I CODE'="N"!('INCK) D
|
|
.. W !!,"CLINIC: ",$$GET1^DIQ(409.32,SDWLSC_",",.01)," INSTITUTION: "
|
|
.. W $$GET1^DIQ(4,SDWLINS_",",.01)
|
|
.. D GETINS Q:SDWLERR=1
|
|
.. K ^SDWL(409.32,"C",+SDWLINS) S $P(^SDWL(409.32,SDWLSC,0),U,6)=SDWLINSN,^SDWL(409.32,"C",SDWLINSN,SDWLSC)=""
|
|
.. S SDWLIN(44,+$P(^SDWL(409.32,SDWLSC,0),"^")_",",3)=SDWLINSN D UPDATE^DIE("","SDWLIN","SDWLMSG") K SDWLIN
|
|
K ^SDWL(409.32,"ACT") S DIK="^SDWL(409.32," D IXALL^DIK
|
|
Q:SDWLERR=1
|
|
W !!,"Checking file 409.3 one last time.",!
|
|
S SDWLERR=""
|
|
S SDWLDA=0,TAG="CHK" F S SDWLDA=$O(^SDWL(409.3,SDWLDA)) Q:SDWLDA<1 D Q:SDWLERR=1
|
|
.S X=$G(^SDWL(409.3,SDWLDA,0)),SDWLINST=$P(X,"^",3),SDWLTY=$P(X,"^",5)
|
|
.Q:'SDWLTY!'SDWLINST
|
|
.S SDWLI=$P(X,"^",SDWLTY+5) Q:'SDWLI
|
|
.S TAG="CHK",TAG=TAG_SDWLTY,C=0 K ^TMP($J,"SDWLCU5",$J) D @TAG
|
|
W !,"Done."
|
|
Q
|
|
CHK1 ;CHECK FOR INSTITUTION VALIDILITY
|
|
S SDWLERR=0
|
|
I SDWLTY=1 S SDWLI=0 F S SDWLI=$O(^SCTM(404.51,"AINST",SDWLI)) Q:SDWLI="" I $D(^DIC(4,SDWLI)) S C=C+1,^TMP($J,"SDWLCU5",$J,C,SDWLI)="",^TMP($J,"SDWLCU5",$J,"B",SDWLI)=""
|
|
I $D(^TMP($J,"SDWLCU5",$J,"B",SDWLINST)) Q
|
|
K ^TMP($J,"SDWLCU5",$J,"B")
|
|
I 'C S SDWLINSN=$S($D(DUZ(2)):DUZ(2),1:"") D CH1E Q
|
|
I C=1 S SDWLINSN=$O(^TMP($J,"SDWLCU5",$J,C,0)) D CH1E Q
|
|
W !,"Please select a valid Institution for this record from the following list for",!
|
|
D DIS
|
|
S C=0,SDWLI="" F S C=$O(^TMP($J,"SDWLCU5",$J,C)) Q:C<1 D
|
|
.F S SDWLI=$O(^TMP($J,"SDWLCU5",$J,C,SDWLI)) Q:SDWLI="" W !,?20,C,". ",$$GET1^DIQ(4,SDWLI_",",.01) S CS=C
|
|
CHK10 W ! S DIR(0)="NO^1:"_CS D ^DIR
|
|
I Y<1!($D(DUOUT)) W !,"Response Required." S SDWLERR=1 Q
|
|
S SDWLINSN=$O(^TMP($J,"SDWLCU5",$J,+Y,0))
|
|
CH1E S SDWLINS(409.3,SDWLDA_",",2)=SDWLINSN D UPDATE^DIE("","SDWLINS","SDWLMSG")
|
|
S TAG="CHK"
|
|
Q
|
|
CHK3 ;
|
|
S SDWLERR=""
|
|
S SDWLI=$P(^SDWL(409.3,SDWLDA,0),U,8)
|
|
Q:'SDWLI!'$D(^SDWL(409.31,SDWLI))
|
|
I '$D(^SDWL(409.31,SDWLI,"I","B",SDWLINST)) D Q:SDWLERR=1
|
|
.S SDWLIX="",C=0 F S SDWLIX=$O(^SDWL(409.31,SDWLI,"I","B",SDWLIX)) Q:SDWLIX="" S C=C+1,^TMP($J,"SDWLCU5",$J,C,SDWLIX)="",^TMP($J,"SDWLCU5",$J,"B",SDWLIX)=""
|
|
.I 'C S SDWLINSN=$S($D(DUZ(2)):DUZ(2),1:""),Y=1 D CHE3 Q
|
|
.I C=1 S SDWLINSN=$O(^TMP($J,"SDWLCU5",$J,C,0)),Y=1 D CHE3 Q
|
|
.W !,"Please select a valid Institution for this record from the following list for",!
|
|
.D DIS
|
|
.S C=0,SDWLIZ=0 F S SDWLIZ=$O(^SDWL(409.31,SDWLI,"I","B",SDWLIZ)) Q:SDWLIZ="" D
|
|
..Q:$$GET1^DIQ(4,SDWLIZ_",",11,"I")'="N"!('$$TF^XUAF4(SDWLIZ))
|
|
..S C=C+1 W !,?20,C,". ",$$GET1^DIQ(4,SDWLIZ_",",.01)
|
|
.W ! S DIR(0)="NO^1:"_C D ^DIR
|
|
.I $D(DUOUT)!(Y="") S SDWLERR=1 Q
|
|
.S SDWLINSN=$O(^TMP($J,"SDWLCU5",$J,+Y,0))
|
|
.D CHE3
|
|
Q
|
|
CHE3 ;
|
|
G CHK3:Y<0
|
|
S SDWLINS(409.3,SDWLDA_",",2)=SDWLINSN D UPDATE^DIE("","SDWLINS","SDWLMSG")
|
|
S TAG="CHK"
|
|
Q
|
|
CHK4 ;
|
|
S SDWLI=$P(^SDWL(409.3,SDWLDA,0),U,9)
|
|
Q:'SDWLI!'$D(^SDWL(409.32,SDWLI,0))
|
|
I $P(^SDWL(409.32,SDWLI,0),U,6)'=SDWLINST D
|
|
.D DIS
|
|
.S SDWLINSN=$P(^SDWL(409.32,SDWLI,0),U,6),SDWLINS(409.3,SDWLDA_",",2)=SDWLINSN D UPDATE^DIE("","SDWLINS","SDWLMSG")
|
|
Q
|
|
CHK2 ;
|
|
S SDWLPO=$P($G(^SDWL(409.3,SDWLDA,0)),U,7),SDWLTM=$P($G(^SCTM(404.57,SDWLPO,0)),U,2),SDWLINSN=$P($G(^SCTM(404.51,SDWLTM,0)),U,7)
|
|
I SDWLINST'=SDWLINSN D
|
|
.S SDWLINS(409.3,SDWLDA_",",2)=SDWLINSN D UPDATE^DIE("","SDWLINS","SDWLMSG")
|
|
S TAG="CHK"
|
|
Q
|
|
DIS ;display record
|
|
S NN=$P($G(^SDWL(409.3,SDWLDA,0)),"^"),NAME=$$GET1^DIQ(2,NN_",",.01,"E")
|
|
S SSN=$$GET1^DIQ(2,NN_",",.09)
|
|
W !,"Record#: ",SDWLDA," Patient: ",NAME," (",SSN,")",!!
|
|
Q
|
|
GETINS ;Get institution
|
|
N DIR
|
|
S DIR("A")="Select Institution: "
|
|
S DIR(0)="PAO^4:EMZ",DIR("S")="I $P(^DIC(4,+Y,0),U,11)=""N"",$$TF^XUAF4(+Y)" D ^DIR
|
|
I X["^" S SDWLERR=1 Q
|
|
I Y<1 W *7,"Invalid Entry" G GETINS
|
|
S SDWLINSN=+Y
|
|
Q
|