Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SDTMPUT1

SDTMPUT1.m

Go to the documentation of this file.
  1. SDTMPUT1 ;MS/SJA - VISTA-TELEHEALTH UPDATE UTILITY ;Dec 17, 2020
  1. ;;5.3;Scheduling;**773**;Aug 13, 1993;Build 9
  1. ;
  1. ;
  1. N ACT,ALL,CLN,DIV,III,SDALL,SDASH,SDEF,SDOUT,SDLT,SDV1,STIEN,XX,SEL,TOT,VAUTD
  1. EN ;
  1. S $P(SDASH,"=",80)="",(SEL,ACT,DIV)="",(ALL,SDOUT)=0
  1. W @IOF W !,?22,"VistA Real-Time Clinic Updates",!
  1. D ASK Q:SDOUT
  1. S:$G(VAUTD)=1 DIV="ALL"
  1. W ! D @SEL
  1. G EN
  1. ;
  1. C ; clinic
  1. K ^TMP($J)
  1. K DIC,DTOUT,DUOUT S DIC="^SC(",DIC(0)="AEQM",DIC("A")="Select Clinic: "
  1. 1 D ^DIC I Y>0 S ^TMP($J,+Y)="",DIC("A")="Another one:" G 1
  1. I $D(DTOUT)!($D(DUOUT))!('$O(^TMP($J,0))) Q
  1. W !!,SDASH,!
  1. F III=0:0 S III=$O(^TMP($J,III)) Q:'III W !,"Clinic: ",III,?15,$$GET1^DIQ(44,III,.01)
  1. W !,SDASH,!
  1. F III=0:0 S III=$O(^TMP($J,III)) Q:'III D
  1. . D EN^SDTMPHLB(III) W !,"Sending HL7 message for Clinic: ",$$GET1^DIQ(44,III,.01)
  1. W !! S DIR(0)="EA",DIR("A")="Press <Enter> to continue" D ^DIR K DIR
  1. Q
  1. ;
  1. S ; stop codes
  1. K ^TMP($J),^TMP($J,"CLN") S (TOT,TOT(0),TOT(1))=0
  1. K DIC,DTOUT,DUOUT S DIC="^SD(40.6,",DIC(0)="AEMQ",DIC("A")="Select Telehealth Stop Code: "
  1. 2 D ^DIC I Y>0 S ^TMP($J,+Y)="",DIC("A")="Select another Telehealth Stop Code: " G 2
  1. I $D(DTOUT)!($D(DUOUT))!('$O(^TMP($J,0))) Q
  1. W !!,SDASH,!
  1. F STIEN=0:0 S STIEN=$O(^TMP($J,STIEN)) Q:'STIEN S CLN=$$ST(STIEN,DIV)
  1. F III=0:0 S III=$O(^TMP($J,"CLN",III)) Q:'III D
  1. . W:TOT=0 !,SDASH,!
  1. . D EN^SDTMPHLB(III) W !,"Sending HL7 message for Clinic: ",III,"-",$$GET1^DIQ(44,III,.01) S TOT=TOT+1
  1. W !!
  1. I ACT="B" D
  1. . W !,"Total number of Active clinics updated: ",TOT(1)
  1. . W !,"Total number of Inactive clinics updated: ",TOT(0)
  1. W !,"Total number of clinics updated: ",TOT
  1. W !! S DIR(0)="EA",DIR("A")="Press <Enter> to continue" D ^DIR K DIR
  1. Q
  1. ST(STIEN,DIV) ;
  1. N FLG1,FLG2,CODE,STP1,STP2,F407,S407,II,NODE0,STOP1,STOP2,XX
  1. S (F407,S407,STP1,STP2)=0
  1. S CODE=$G(^SD(40.6,STIEN,0)),STP1=$E(CODE,1,3),STP2=$E(CODE,4,6)
  1. S F407=$O(^DIC(40.7,"C",STP1,0)) S:STP2 S407=$O(^DIC(40.7,"C",STP2,0))
  1. S II=0
  1. F S II=$O(^SC(II)) Q:'II S (FLG1,FLG2)=0 D
  1. . S NODE0=$G(^SC(II,0)) I DIV'="ALL" Q:'$$DIVCHK($P(NODE0,U,15))
  1. . S STOP1=$P(NODE0,"^",7),STOP2=$P(NODE0,"^",18)
  1. . Q:($G(STOP1)="")&(($G(STOP2))="")
  1. . I $G(F407)!$G(S407) D
  1. . . I (F407=STOP1)!(S407=STOP1) S FLG1=1
  1. . . I (F407=STOP2)!(S407=STOP2) S FLG2=1
  1. . I 'FLG1,'FLG2 Q
  1. . S XX=$$ACTIVE(II) I ACT="B" S TOT(XX)=TOT(XX)+1
  1. . I (XX&(ACT="I"))!('XX&(ACT="A")) Q
  1. . 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
  1. . . S ^TMP($J,"CLN",II)=""
  1. Q 1
  1. ;
  1. EXIT ;
  1. K DTOUT,DUOUT,DTOT
  1. K ^TMP($J)
  1. Q
  1. ;
  1. ASK W ! K DIR,Y S DIR(0)="SA^C:Clinic;S:Stop Code;Q:Quit"
  1. S DIR("A")="Select (C)linic, (S)top Code or (Q)uit: "
  1. S DIR("B")="C"
  1. D ^DIR K DIR I Y="Q"!$D(DTOUT)!$D(DUOUT) S SDOUT=1 Q
  1. S SEL=Y W ! I SEL="C" Q
  1. ;
  1. S DIR(0)="SA^A:Active;I:Inactive;B:Both"
  1. S DIR("A")="(A)ctive Clinics, (I)nactive Clinics, (B)oth: "
  1. S DIR("?",1)="Enter an 'A' for Active Clinics, 'I' for Inactive Clinics,"
  1. S DIR("?")="'B' for Both Active and Inactive Clinics"
  1. S DIR("B")="A"
  1. D ^DIR K DIR I $D(DTOUT)!$D(DUOUT) S SDOUT=1 Q
  1. S ACT=Y W !
  1. ;
  1. DIV ; ask for division
  1. D ASK2^SDDIV S:Y<0 SDOUT=1
  1. Q
  1. ;
  1. DIVCHK(CLNDIV) ; check clinic division
  1. N FLG,FF
  1. S FLG=0
  1. I $G(VAUTD)=0 S FF=0 F S FF=$O(VAUTD(FF)) Q:'FF I CLNDIV=FF S FLG=1 Q
  1. Q FLG
  1. ;
  1. ACTIVE(LOC) ;determine if clinic is active
  1. ; Output X:1=ACTIVE,
  1. ; X:0=INACTIVE
  1. N NODE,I1,I2,X
  1. S X=0
  1. S NODE=$G(^SC(LOC,"I")) Q:NODE="" 1
  1. S I1=$P(NODE,U,1) ;inactive date/time
  1. S I2=$P(NODE,U,2) ;reactive date/time
  1. I (I1="") S X=1 Q X
  1. I ((I1'="")&(I1>DT))!((I2'="")&(I2'>DT)) S X=1 Q X
  1. Q X
  1. ;