SDTMPUT1 ;MS/SJA - VISTA-TELEHEALTH UPDATE UTILITY ;Dec 17, 2020
;;5.3;Scheduling;**773**;Aug 13, 1993;Build 9
;
;
N ACT,ALL,CLN,DIV,III,SDALL,SDASH,SDEF,SDOUT,SDLT,SDV1,STIEN,XX,SEL,TOT,VAUTD
EN ;
S $P(SDASH,"=",80)="",(SEL,ACT,DIV)="",(ALL,SDOUT)=0
W @IOF W !,?22,"VistA Real-Time Clinic Updates",!
D ASK Q:SDOUT
S:$G(VAUTD)=1 DIV="ALL"
W ! D @SEL
G EN
;
C ; clinic
K ^TMP($J)
K DIC,DTOUT,DUOUT S DIC="^SC(",DIC(0)="AEQM",DIC("A")="Select Clinic: "
1 D ^DIC I Y>0 S ^TMP($J,+Y)="",DIC("A")="Another one:" G 1
I $D(DTOUT)!($D(DUOUT))!('$O(^TMP($J,0))) Q
W !!,SDASH,!
F III=0:0 S III=$O(^TMP($J,III)) Q:'III W !,"Clinic: ",III,?15,$$GET1^DIQ(44,III,.01)
W !,SDASH,!
F III=0:0 S III=$O(^TMP($J,III)) Q:'III D
. D EN^SDTMPHLB(III) W !,"Sending HL7 message for Clinic: ",$$GET1^DIQ(44,III,.01)
W !! S DIR(0)="EA",DIR("A")="Press <Enter> to continue" D ^DIR K DIR
Q
;
S ; stop codes
K ^TMP($J),^TMP($J,"CLN") S (TOT,TOT(0),TOT(1))=0
K DIC,DTOUT,DUOUT S DIC="^SD(40.6,",DIC(0)="AEMQ",DIC("A")="Select Telehealth Stop Code: "
2 D ^DIC I Y>0 S ^TMP($J,+Y)="",DIC("A")="Select another Telehealth Stop Code: " G 2
I $D(DTOUT)!($D(DUOUT))!('$O(^TMP($J,0))) Q
W !!,SDASH,!
F STIEN=0:0 S STIEN=$O(^TMP($J,STIEN)) Q:'STIEN S CLN=$$ST(STIEN,DIV)
F III=0:0 S III=$O(^TMP($J,"CLN",III)) Q:'III D
. W:TOT=0 !,SDASH,!
. D EN^SDTMPHLB(III) W !,"Sending HL7 message for Clinic: ",III,"-",$$GET1^DIQ(44,III,.01) S TOT=TOT+1
W !!
I ACT="B" D
. W !,"Total number of Active clinics updated: ",TOT(1)
. W !,"Total number of Inactive clinics updated: ",TOT(0)
W !,"Total number of clinics updated: ",TOT
W !! S DIR(0)="EA",DIR("A")="Press <Enter> to continue" D ^DIR K DIR
Q
ST(STIEN,DIV) ;
N FLG1,FLG2,CODE,STP1,STP2,F407,S407,II,NODE0,STOP1,STOP2,XX
S (F407,S407,STP1,STP2)=0
S CODE=$G(^SD(40.6,STIEN,0)),STP1=$E(CODE,1,3),STP2=$E(CODE,4,6)
S F407=$O(^DIC(40.7,"C",STP1,0)) S:STP2 S407=$O(^DIC(40.7,"C",STP2,0))
S II=0
F S II=$O(^SC(II)) Q:'II S (FLG1,FLG2)=0 D
. S NODE0=$G(^SC(II,0)) I DIV'="ALL" Q:'$$DIVCHK($P(NODE0,U,15))
. S STOP1=$P(NODE0,"^",7),STOP2=$P(NODE0,"^",18)
. Q:($G(STOP1)="")&(($G(STOP2))="")
. I $G(F407)!$G(S407) D
. . I (F407=STOP1)!(S407=STOP1) S FLG1=1
. . I (F407=STOP2)!(S407=STOP2) S FLG2=1
. I 'FLG1,'FLG2 Q
. S XX=$$ACTIVE(II) I ACT="B" S TOT(XX)=TOT(XX)+1
. I (XX&(ACT="I"))!('XX&(ACT="A")) Q
. W !,"Clinic: ",II W:ACT="B" ?15,$S(XX:"'A'",'XX:"'I'",1:"") W ?20,"(",$S(STOP1:$$GET1^DIQ(40.7,STOP1,1),1:" "),"/",$S(STOP2:$$GET1^DIQ(40.7,STOP2,1),1:" "),") ",$P(NODE0,U) D
. . S ^TMP($J,"CLN",II)=""
Q 1
;
EXIT ;
K DTOUT,DUOUT,DTOT
K ^TMP($J)
Q
;
ASK W ! K DIR,Y S DIR(0)="SA^C:Clinic;S:Stop Code;Q:Quit"
S DIR("A")="Select (C)linic, (S)top Code or (Q)uit: "
S DIR("B")="C"
D ^DIR K DIR I Y="Q"!$D(DTOUT)!$D(DUOUT) S SDOUT=1 Q
S SEL=Y W ! I SEL="C" Q
;
S DIR(0)="SA^A:Active;I:Inactive;B:Both"
S DIR("A")="(A)ctive Clinics, (I)nactive Clinics, (B)oth: "
S DIR("?",1)="Enter an 'A' for Active Clinics, 'I' for Inactive Clinics,"
S DIR("?")="'B' for Both Active and Inactive Clinics"
S DIR("B")="A"
D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SDOUT=1 Q
S ACT=Y W !
;
DIV ; ask for division
D ASK2^SDDIV S:Y<0 SDOUT=1
Q
;
DIVCHK(CLNDIV) ; check clinic division
N FLG,FF
S FLG=0
I $G(VAUTD)=0 S FF=0 F S FF=$O(VAUTD(FF)) Q:'FF I CLNDIV=FF S FLG=1 Q
Q FLG
;
ACTIVE(LOC) ;determine if clinic is active
; Output X:1=ACTIVE,
; X:0=INACTIVE
N NODE,I1,I2,X
S X=0
S NODE=$G(^SC(LOC,"I")) Q:NODE="" 1
S I1=$P(NODE,U,1) ;inactive date/time
S I2=$P(NODE,U,2) ;reactive date/time
I (I1="") S X=1 Q X
I ((I1'="")&(I1>DT))!((I2'="")&(I2'>DT)) S X=1 Q X
Q X
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDTMPUT1 3758 printed Dec 13, 2024@03:01:39 Page 2
SDTMPUT1 ;MS/SJA - VISTA-TELEHEALTH UPDATE UTILITY ;Dec 17, 2020
+1 ;;5.3;Scheduling;**773**;Aug 13, 1993;Build 9
+2 ;
+3 ;
+4 NEW ACT,ALL,CLN,DIV,III,SDALL,SDASH,SDEF,SDOUT,SDLT,SDV1,STIEN,XX,SEL,TOT,VAUTD
EN ;
+1 SET $PIECE(SDASH,"=",80)=""
SET (SEL,ACT,DIV)=""
SET (ALL,SDOUT)=0
+2 WRITE @IOF
WRITE !,?22,"VistA Real-Time Clinic Updates",!
+3 DO ASK
if SDOUT
QUIT
+4 if $GET(VAUTD)=1
SET DIV="ALL"
+5 WRITE !
DO @SEL
+6 GOTO EN
+7 ;
C ; clinic
+1 KILL ^TMP($JOB)
+2 KILL DIC,DTOUT,DUOUT
SET DIC="^SC("
SET DIC(0)="AEQM"
SET DIC("A")="Select Clinic: "
1 DO ^DIC
IF Y>0
SET ^TMP($JOB,+Y)=""
SET DIC("A")="Another one:"
GOTO 1
+1 IF $DATA(DTOUT)!($DATA(DUOUT))!('$ORDER(^TMP($JOB,0)))
QUIT
+2 WRITE !!,SDASH,!
+3 FOR III=0:0
SET III=$ORDER(^TMP($JOB,III))
if 'III
QUIT
WRITE !,"Clinic: ",III,?15,$$GET1^DIQ(44,III,.01)
+4 WRITE !,SDASH,!
+5 FOR III=0:0
SET III=$ORDER(^TMP($JOB,III))
if 'III
QUIT
Begin DoDot:1
+6 DO EN^SDTMPHLB(III)
WRITE !,"Sending HL7 message for Clinic: ",$$GET1^DIQ(44,III,.01)
End DoDot:1
+7 WRITE !!
SET DIR(0)="EA"
SET DIR("A")="Press <Enter> to continue"
DO ^DIR
KILL DIR
+8 QUIT
+9 ;
S ; stop codes
+1 KILL ^TMP($JOB),^TMP($JOB,"CLN")
SET (TOT,TOT(0),TOT(1))=0
+2 KILL DIC,DTOUT,DUOUT
SET DIC="^SD(40.6,"
SET DIC(0)="AEMQ"
SET DIC("A")="Select Telehealth Stop Code: "
2 DO ^DIC
IF Y>0
SET ^TMP($JOB,+Y)=""
SET DIC("A")="Select another Telehealth Stop Code: "
GOTO 2
+1 IF $DATA(DTOUT)!($DATA(DUOUT))!('$ORDER(^TMP($JOB,0)))
QUIT
+2 WRITE !!,SDASH,!
+3 FOR STIEN=0:0
SET STIEN=$ORDER(^TMP($JOB,STIEN))
if 'STIEN
QUIT
SET CLN=$$ST(STIEN,DIV)
+4 FOR III=0:0
SET III=$ORDER(^TMP($JOB,"CLN",III))
if 'III
QUIT
Begin DoDot:1
+5 if TOT=0
WRITE !,SDASH,!
+6 DO EN^SDTMPHLB(III)
WRITE !,"Sending HL7 message for Clinic: ",III,"-",$$GET1^DIQ(44,III,.01)
SET TOT=TOT+1
End DoDot:1
+7 WRITE !!
+8 IF ACT="B"
Begin DoDot:1
+9 WRITE !,"Total number of Active clinics updated: ",TOT(1)
+10 WRITE !,"Total number of Inactive clinics updated: ",TOT(0)
End DoDot:1
+11 WRITE !,"Total number of clinics updated: ",TOT
+12 WRITE !!
SET DIR(0)="EA"
SET DIR("A")="Press <Enter> to continue"
DO ^DIR
KILL DIR
+13 QUIT
ST(STIEN,DIV) ;
+1 NEW FLG1,FLG2,CODE,STP1,STP2,F407,S407,II,NODE0,STOP1,STOP2,XX
+2 SET (F407,S407,STP1,STP2)=0
+3 SET CODE=$GET(^SD(40.6,STIEN,0))
SET STP1=$EXTRACT(CODE,1,3)
SET STP2=$EXTRACT(CODE,4,6)
+4 SET F407=$ORDER(^DIC(40.7,"C",STP1,0))
if STP2
SET S407=$ORDER(^DIC(40.7,"C",STP2,0))
+5 SET II=0
+6 FOR
SET II=$ORDER(^SC(II))
if 'II
QUIT
SET (FLG1,FLG2)=0
Begin DoDot:1
+7 SET NODE0=$GET(^SC(II,0))
IF DIV'="ALL"
if '$$DIVCHK($PIECE(NODE0,U,15))
QUIT
+8 SET STOP1=$PIECE(NODE0,"^",7)
SET STOP2=$PIECE(NODE0,"^",18)
+9 if ($GET(STOP1)="")&(($GET(STOP2))="")
QUIT
+10 IF $GET(F407)!$GET(S407)
Begin DoDot:2
+11 IF (F407=STOP1)!(S407=STOP1)
SET FLG1=1
+12 IF (F407=STOP2)!(S407=STOP2)
SET FLG2=1
End DoDot:2
+13 IF 'FLG1
IF 'FLG2
QUIT
+14 SET XX=$$ACTIVE(II)
IF ACT="B"
SET TOT(XX)=TOT(XX)+1
+15 IF (XX&(ACT="I"))!('XX&(ACT="A"))
QUIT
+16 WRITE !,"Clinic: ",II
if ACT="B"
WRITE ?15,$SELECT(XX:"'A'",'XX:"'I'",1:"")
WRITE ?20,"(",$SELECT(STOP1:$$GET1^DIQ(40.7,STOP1,1),1:" "),"/",$SELECT(STOP2:$$GET1^DIQ(40.7,STOP2,1),1:" "),") ",$PIECE(NODE0,U)
Begin DoDot:2
+17 SET ^TMP($JOB,"CLN",II)=""
End DoDot:2
End DoDot:1
+18 QUIT 1
+19 ;
EXIT ;
+1 KILL DTOUT,DUOUT,DTOT
+2 KILL ^TMP($JOB)
+3 QUIT
+4 ;
ASK WRITE !
KILL DIR,Y
SET DIR(0)="SA^C:Clinic;S:Stop Code;Q:Quit"
+1 SET DIR("A")="Select (C)linic, (S)top Code or (Q)uit: "
+2 SET DIR("B")="C"
+3 DO ^DIR
KILL DIR
IF Y="Q"!$DATA(DTOUT)!$DATA(DUOUT)
SET SDOUT=1
QUIT
+4 SET SEL=Y
WRITE !
IF SEL="C"
QUIT
+5 ;
+6 SET DIR(0)="SA^A:Active;I:Inactive;B:Both"
+7 SET DIR("A")="(A)ctive Clinics, (I)nactive Clinics, (B)oth: "
+8 SET DIR("?",1)="Enter an 'A' for Active Clinics, 'I' for Inactive Clinics,"
+9 SET DIR("?")="'B' for Both Active and Inactive Clinics"
+10 SET DIR("B")="A"
+11 DO ^DIR
KILL DIR
IF $DATA(DTOUT)!$DATA(DUOUT)
SET SDOUT=1
QUIT
+12 SET ACT=Y
WRITE !
+13 ;
DIV ; ask for division
+1 DO ASK2^SDDIV
if Y<0
SET SDOUT=1
+2 QUIT
+3 ;
DIVCHK(CLNDIV) ; check clinic division
+1 NEW FLG,FF
+2 SET FLG=0
+3 IF $GET(VAUTD)=0
SET FF=0
FOR
SET FF=$ORDER(VAUTD(FF))
if 'FF
QUIT
IF CLNDIV=FF
SET FLG=1
QUIT
+4 QUIT FLG
+5 ;
ACTIVE(LOC) ;determine if clinic is active
+1 ; Output X:1=ACTIVE,
+2 ; X:0=INACTIVE
+3 NEW NODE,I1,I2,X
+4 SET X=0
+5 SET NODE=$GET(^SC(LOC,"I"))
if NODE=""
QUIT 1
+6 ;inactive date/time
SET I1=$PIECE(NODE,U,1)
+7 ;reactive date/time
SET I2=$PIECE(NODE,U,2)
+8 IF (I1="")
SET X=1
QUIT X
+9 IF ((I1'="")&(I1>DT))!((I2'="")&(I2'>DT))
SET X=1
QUIT X
+10 QUIT X
+11 ;
