- 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 Feb 19, 2025@00:28:09 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 ;