EHMAPPT3 ;ALB/WTC - EHRM APPOINTMENT MAINTENANCE; Jan 22, 2025@15:13:02
;;1.0;ELECTRONIC HEALTH MODERNIZATION;**13**;Apr 19, 2021;Build 27
;
;
Q ;
;
CNVTD ;
;
; Summary of converted appointments with action required encounters.
;
N CONVDATE,CLINFLTR,DFN,APPTDTTM,CLINIC,X1,X2,X3,LASTFI,SORT1,SORT2,SORT3,OUTPTFMT,Y,POP,%ZIS,DIRUT,QUEUED,OUTPTFMT,TITLE,CLINICS,NONCOUNT ;
;
D CNVSELCT^EHMAPPT("OTHER",.CONVDATE,1,.CLINFLTR,.CLINICS,,.NONCOUNT) Q:$D(DIRUT) Q:CONVDATE="" Q:CLINFLTR="" Q:NONCOUNT="" ;
;
S %ZIS="Q" D ^%ZIS I POP K ^TMP($J) Q ;
;
; If report is queued, add to Taskman
;
S QUEUED=0 I $D(IO("Q")) S QUEUED=1 D Q ;
. N ZTDESC,ZTRTN,ZTSAVE,ZTSK ;
. S ZTRTN="CNVTD1^EHMAPPT2",ZTDESC="Action Required Encounters Summary" ;
. S ZTSAVE("*")="" ;
. D ^%ZTLOAD W $S($D(ZTSK):"...Task queued",1:"...Task cancelled"),! ;
;
CNVTD1 ; TaskMan start point
;
; Build list of converted appointments.
;
U IO D CNVTDAPT^EHMAPPT("OTHER",CONVDATE,1,CLINFLTR,.CLINICS,,NONCOUNT,QUEUED,1,1) ; Build list of converted appointments.
S TITLE(1)="SUMMARY OF CONVERTED APPOINTMENTS WITH ACTION REQUIRED ENCOUNTERS" ;
D SUMOUT^EHMAPPT2(.TITLE,CONVDATE,QUEUED,1) ;
;
D ^%ZISC ;
K ^TMP($J) ;
Q ;
;
POSTLIVE ;
;
; Summary of post-conversion appointments with action required encounters.
;
N CONVDATE,CLINFLTR,CLINICS,DFN,APPTDTTM,CLINIC,X1,X2,X3,LASTFI,SORT1,SORT2,SORT3,OUTPTFMT,Y,POP,%ZIS,QUEUED,CLINICS,NONCOUNT ;
;
D POSTSLCT^EHMAPPT0("OTHER",.CONVDATE,1,.CLINFLTR,.CLINICS,,.NONCOUNT) Q:$D(DIRUT) Q:CONVDATE="" Q:CLINFLTR="" Q:NONCOUNT="" ;
;
S %ZIS="Q" D ^%ZIS I POP K ^TMP($J) Q ;
;
; If report is queued, add to Taskman
;
S QUEUED=0 I $D(IO("Q")) S QUEUED=1 D Q ;
. N ZTDESC,ZTRTN,ZTSAVE,ZTSK ;
. S ZTRTN="POSTLIV1^EHMAPPT2",ZTDESC="Action Required Encounters Summary" ;
. S ZTSAVE("*")="" ;
. D ^%ZTLOAD W $S($D(ZTSK):"...Task queued",1:"...Task cancelled"),! ;
;
POSTLIV1 ; TaskMan start point
;
; Build list of post-conversion appointments.
;
U IO D POSTLIVE^EHMAPPT0("OTHER",CONVDATE,1,CLINFLTR,.CLINICS,,NONCOUNT,QUEUED,1,1) ; Build list of post-conversion appointments.
S TITLE(1)="SUMMARY OF POST-CONVERSION APPOINTMENTS WITH ACTION REQUIRED ENCOUNTERS" ;
D SUMOUT^EHMAPPT2(.TITLE,CONVDATE,QUEUED,1) ;
;
D ^%ZISC ;
K ^TMP($J) ;
Q ;
;
ALLAPPT ;
;
; Summary of all appointments with action required encounters.
;
N CONVDATE,CLINFLTR,CLINICS,DFN,APPTDTTM,CLINIC,X1,X2,X3,LASTFI,SORT1,SORT2,SORT3,OUTPTFMT,Y,POP,%ZIS,DIRUT,QUEUED,OUTPTFMT,TITLE ;
;
D ALLSLCT^EHMAPPT0("OTHER",1,.CLINFLTR,.CLINICS,,.NONCOUNT) Q:CLINFLTR="" Q:NONCOUNT="" ;
;
S %ZIS="Q" D ^%ZIS I POP K ^TMP($J) Q ;
;
; If report is queued, add to Taskman
;
S QUEUED=0 I $D(IO("Q")) S QUEUED=1 D Q ;
. N ZTDESC,ZTRTN,ZTSAVE,ZTSK ;
. S ZTRTN="ALLAPPT1^EHMAPPT2",ZTDESC="Action Required Encounters Summary" ;
. S ZTSAVE("*")="" ;
. D ^%ZTLOAD W $S($D(ZTSK):"...Task queued",1:"...Task cancelled"),! ;
;
ALLAPPT1 ; TaskMan start point
;
; Build list of all appointments.
;
U IO D ALLAPPTS^EHMAPPT0("OTHER",1,CLINFLTR,.CLINICS,,NONCOUNT,QUEUED,1,1) ; Build list of appointments.
S TITLE(1)="SUMMARY OF ALL APPOINTMENTS WITH ACTION REQUIRED ENCOUNTERS" ;
D SUMOUT^EHMAPPT2(.TITLE,,QUEUED,1) ;
;
D ^%ZISC ;
K ^TMP($J) ;
Q ;
;
EDIT1610 ;
;
; Add/Edit EHRM ACTIVE CLINIC FILE (#1610)
;
N DIC,X,Y,IEN,DIR,DIK,DA,DIRUT,SELECTBY,STOPCODE,INACTDT,REACTDT,I,ACTION ;
;
K DIR S DIR(0)="SO^NAME:Clinic Name;STOP:Stop Code",DIR("A")="Select by",DIR("B")="NAME" D ^DIR Q:$D(DIRUT) S SELECTBY=Y ;
;
I SELECTBY="NAME" D Q ;
. ;
. W !,"Select CLINIC to add or delete from the EHRM ACTIVE CLINIC file.",! ;
. S Y=-1 F I=0:0 D Q:Y<0 ;
.. K DIC S DIC=44,DIC(0)="AEQM" D ^DIC Q:Y<0 S IEN=+Y W ! ;
.. ;
.. I $D(^EHRM(1610,"B",IEN)) D Q ;
... ;
... K DIR S DIR(0)="Y",DIR("A")="Delete clinic from EHRM ACTIVE CLINIC file?",DIR("B")="NO" D ^DIR Q:'Y ;
... ;
... K DIK S DIK=^DIC(1610,0,"GL"),DA=$O(^EHRM(1610,"B",IEN,0)) D ^DIK W "...Deleted" ;
.. ;
.. I '$D(^EHRM(1610,"B",IEN)) D Q ;
... ;
... S INACTDT=$$GET1^DIQ(44,IEN,2505,"I"),REACTDT=$$GET1^DIQ(44,IEN,2506,"I") ;
... I INACTDT'="",INACTDT'>DT,REACTDT=""!(REACTDT>DT) W "...Inactive. Skipped." Q ;
... ;
... K DIR S DIR(0)="Y",DIR("A")="Add clinic to EHRM ACTIVE CLINIC file?",DIR("B")="YES" D ^DIR Q:'Y ;
... ;
... K DIC S DIC=1610,DIC(0)="L",X=IEN D FILE^DICN W "...Added" ;
;
I SELECTBY="STOP" D Q ;
. ;
. W !,"Select STOP CODE of clinics to add or delete from the EHRM ACTIVE CLINIC file.",! ;
. K DIC S DIC=40.7,DIC(0)="AEQM" D ^DIC Q:Y<0 S STOPCODE=+Y W ! ;
. ;
. K DIR S DIR(0)="S^A:Add;D:Delete",DIR("A")="Clinics matching stop code",DIR("B")="A" D ^DIR Q:Y="" Q:$D(DIRUT) S ACTION=Y W ! ;
. ;
. I ACTION="A" D ;
.. S IEN=0 F S IEN=$O(^SC("AST",STOPCODE,IEN)) Q:'IEN W !,$$GET1^DIQ(44,IEN,.01) D ;
... ;
... I $D(^EHRM(1610,"B",IEN)) W "...Already in EHRM ACTIVE CLINIC file." Q ; ALREADY ON FILE
... S INACTDT=$$GET1^DIQ(44,IEN,2505,"I"),REACTDT=$$GET1^DIQ(44,IEN,2506,"I") ;
... I INACTDT'="",INACTDT'>DT,REACTDT=""!(REACTDT>DT) W "...Inactive. Skipped." Q ;
... ;
... K DIC S DIC=1610,DIC(0)="L",X=IEN D FILE^DICN W "...Added" ;
.. W ! ;
. ;
. I ACTION="D" D ;
.. S IEN=0 F S IEN=$O(^SC("AST",STOPCODE,IEN)) Q:'IEN W !,$$GET1^DIQ(44,IEN,.01) D ;
... ;
... I '$D(^EHRM(1610,"B",IEN)) W "...Not in file." Q ;
... ;
... K DIK S DIK=^DIC(1610,0,"GL"),DA=$O(^EHRM(1610,"B",IEN,0)) D ^DIK W "...Deleted" ;
;
Q ;
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEHMAPPT3 5673 printed Apr 22, 2026@13:48:20 Page 2
EHMAPPT3 ;ALB/WTC - EHRM APPOINTMENT MAINTENANCE; Jan 22, 2025@15:13:02
+1 ;;1.0;ELECTRONIC HEALTH MODERNIZATION;**13**;Apr 19, 2021;Build 27
+2 ;
+3 ;
+4 ;
QUIT
+5 ;
CNVTD ;
+1 ;
+2 ; Summary of converted appointments with action required encounters.
+3 ;
+4 ;
NEW CONVDATE,CLINFLTR,DFN,APPTDTTM,CLINIC,X1,X2,X3,LASTFI,SORT1,SORT2,SORT3,OUTPTFMT,Y,POP,%ZIS,DIRUT,QUEUED,OUTPTFMT,TITLE,CLINICS,NONCOUNT
+5 ;
+6 ;
DO CNVSELCT^EHMAPPT("OTHER",.CONVDATE,1,.CLINFLTR,.CLINICS,,.NONCOUNT)
if $DATA(DIRUT)
QUIT
if CONVDATE=""
QUIT
if CLINFLTR=""
QUIT
if NONCOUNT=""
QUIT
+7 ;
+8 ;
SET %ZIS="Q"
DO ^%ZIS
IF POP
KILL ^TMP($JOB)
QUIT
+9 ;
+10 ; If report is queued, add to Taskman
+11 ;
+12 ;
SET QUEUED=0
IF $DATA(IO("Q"))
SET QUEUED=1
Begin DoDot:1
+13 ;
NEW ZTDESC,ZTRTN,ZTSAVE,ZTSK
+14 ;
SET ZTRTN="CNVTD1^EHMAPPT2"
SET ZTDESC="Action Required Encounters Summary"
+15 ;
SET ZTSAVE("*")=""
+16 ;
DO ^%ZTLOAD
WRITE $SELECT($DATA(ZTSK):"...Task queued",1:"...Task cancelled"),!
End DoDot:1
QUIT
+17 ;
CNVTD1 ; TaskMan start point
+1 ;
+2 ; Build list of converted appointments.
+3 ;
+4 ; Build list of converted appointments.
USE IO
DO CNVTDAPT^EHMAPPT("OTHER",CONVDATE,1,CLINFLTR,.CLINICS,,NONCOUNT,QUEUED,1,1)
+5 ;
SET TITLE(1)="SUMMARY OF CONVERTED APPOINTMENTS WITH ACTION REQUIRED ENCOUNTERS"
+6 ;
DO SUMOUT^EHMAPPT2(.TITLE,CONVDATE,QUEUED,1)
+7 ;
+8 ;
DO ^%ZISC
+9 ;
KILL ^TMP($JOB)
+10 ;
QUIT
+11 ;
POSTLIVE ;
+1 ;
+2 ; Summary of post-conversion appointments with action required encounters.
+3 ;
+4 ;
NEW CONVDATE,CLINFLTR,CLINICS,DFN,APPTDTTM,CLINIC,X1,X2,X3,LASTFI,SORT1,SORT2,SORT3,OUTPTFMT,Y,POP,%ZIS,QUEUED,CLINICS,NONCOUNT
+5 ;
+6 ;
DO POSTSLCT^EHMAPPT0("OTHER",.CONVDATE,1,.CLINFLTR,.CLINICS,,.NONCOUNT)
if $DATA(DIRUT)
QUIT
if CONVDATE=""
QUIT
if CLINFLTR=""
QUIT
if NONCOUNT=""
QUIT
+7 ;
+8 ;
SET %ZIS="Q"
DO ^%ZIS
IF POP
KILL ^TMP($JOB)
QUIT
+9 ;
+10 ; If report is queued, add to Taskman
+11 ;
+12 ;
SET QUEUED=0
IF $DATA(IO("Q"))
SET QUEUED=1
Begin DoDot:1
+13 ;
NEW ZTDESC,ZTRTN,ZTSAVE,ZTSK
+14 ;
SET ZTRTN="POSTLIV1^EHMAPPT2"
SET ZTDESC="Action Required Encounters Summary"
+15 ;
SET ZTSAVE("*")=""
+16 ;
DO ^%ZTLOAD
WRITE $SELECT($DATA(ZTSK):"...Task queued",1:"...Task cancelled"),!
End DoDot:1
QUIT
+17 ;
POSTLIV1 ; TaskMan start point
+1 ;
+2 ; Build list of post-conversion appointments.
+3 ;
+4 ; Build list of post-conversion appointments.
USE IO
DO POSTLIVE^EHMAPPT0("OTHER",CONVDATE,1,CLINFLTR,.CLINICS,,NONCOUNT,QUEUED,1,1)
+5 ;
SET TITLE(1)="SUMMARY OF POST-CONVERSION APPOINTMENTS WITH ACTION REQUIRED ENCOUNTERS"
+6 ;
DO SUMOUT^EHMAPPT2(.TITLE,CONVDATE,QUEUED,1)
+7 ;
+8 ;
DO ^%ZISC
+9 ;
KILL ^TMP($JOB)
+10 ;
QUIT
+11 ;
ALLAPPT ;
+1 ;
+2 ; Summary of all appointments with action required encounters.
+3 ;
+4 ;
NEW CONVDATE,CLINFLTR,CLINICS,DFN,APPTDTTM,CLINIC,X1,X2,X3,LASTFI,SORT1,SORT2,SORT3,OUTPTFMT,Y,POP,%ZIS,DIRUT,QUEUED,OUTPTFMT,TITLE
+5 ;
+6 ;
DO ALLSLCT^EHMAPPT0("OTHER",1,.CLINFLTR,.CLINICS,,.NONCOUNT)
if CLINFLTR=""
QUIT
if NONCOUNT=""
QUIT
+7 ;
+8 ;
SET %ZIS="Q"
DO ^%ZIS
IF POP
KILL ^TMP($JOB)
QUIT
+9 ;
+10 ; If report is queued, add to Taskman
+11 ;
+12 ;
SET QUEUED=0
IF $DATA(IO("Q"))
SET QUEUED=1
Begin DoDot:1
+13 ;
NEW ZTDESC,ZTRTN,ZTSAVE,ZTSK
+14 ;
SET ZTRTN="ALLAPPT1^EHMAPPT2"
SET ZTDESC="Action Required Encounters Summary"
+15 ;
SET ZTSAVE("*")=""
+16 ;
DO ^%ZTLOAD
WRITE $SELECT($DATA(ZTSK):"...Task queued",1:"...Task cancelled"),!
End DoDot:1
QUIT
+17 ;
ALLAPPT1 ; TaskMan start point
+1 ;
+2 ; Build list of all appointments.
+3 ;
+4 ; Build list of appointments.
USE IO
DO ALLAPPTS^EHMAPPT0("OTHER",1,CLINFLTR,.CLINICS,,NONCOUNT,QUEUED,1,1)
+5 ;
SET TITLE(1)="SUMMARY OF ALL APPOINTMENTS WITH ACTION REQUIRED ENCOUNTERS"
+6 ;
DO SUMOUT^EHMAPPT2(.TITLE,,QUEUED,1)
+7 ;
+8 ;
DO ^%ZISC
+9 ;
KILL ^TMP($JOB)
+10 ;
QUIT
+11 ;
EDIT1610 ;
+1 ;
+2 ; Add/Edit EHRM ACTIVE CLINIC FILE (#1610)
+3 ;
+4 ;
NEW DIC,X,Y,IEN,DIR,DIK,DA,DIRUT,SELECTBY,STOPCODE,INACTDT,REACTDT,I,ACTION
+5 ;
+6 ;
KILL DIR
SET DIR(0)="SO^NAME:Clinic Name;STOP:Stop Code"
SET DIR("A")="Select by"
SET DIR("B")="NAME"
DO ^DIR
if $DATA(DIRUT)
QUIT
SET SELECTBY=Y
+7 ;
+8 ;
IF SELECTBY="NAME"
Begin DoDot:1
+9 ;
+10 ;
WRITE !,"Select CLINIC to add or delete from the EHRM ACTIVE CLINIC file.",!
+11 ;
SET Y=-1
FOR I=0:0
Begin DoDot:2
+12 ;
KILL DIC
SET DIC=44
SET DIC(0)="AEQM"
DO ^DIC
if Y<0
QUIT
SET IEN=+Y
WRITE !
+13 ;
+14 ;
IF $DATA(^EHRM(1610,"B",IEN))
Begin DoDot:3
+15 ;
+16 ;
KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Delete clinic from EHRM ACTIVE CLINIC file?"
SET DIR("B")="NO"
DO ^DIR
if 'Y
QUIT
+17 ;
+18 ;
KILL DIK
SET DIK=^DIC(1610,0,"GL")
SET DA=$ORDER(^EHRM(1610,"B",IEN,0))
DO ^DIK
WRITE "...Deleted"
End DoDot:3
QUIT
+19 ;
+20 ;
IF '$DATA(^EHRM(1610,"B",IEN))
Begin DoDot:3
+21 ;
+22 ;
SET INACTDT=$$GET1^DIQ(44,IEN,2505,"I")
SET REACTDT=$$GET1^DIQ(44,IEN,2506,"I")
+23 ;
IF INACTDT'=""
IF INACTDT'>DT
IF REACTDT=""!(REACTDT>DT)
WRITE "...Inactive. Skipped."
QUIT
+24 ;
+25 ;
KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Add clinic to EHRM ACTIVE CLINIC file?"
SET DIR("B")="YES"
DO ^DIR
if 'Y
QUIT
+26 ;
+27 ;
KILL DIC
SET DIC=1610
SET DIC(0)="L"
SET X=IEN
DO FILE^DICN
WRITE "...Added"
End DoDot:3
QUIT
End DoDot:2
if Y<0
QUIT
End DoDot:1
QUIT
+28 ;
+29 ;
IF SELECTBY="STOP"
Begin DoDot:1
+30 ;
+31 ;
WRITE !,"Select STOP CODE of clinics to add or delete from the EHRM ACTIVE CLINIC file.",!
+32 ;
KILL DIC
SET DIC=40.7
SET DIC(0)="AEQM"
DO ^DIC
if Y<0
QUIT
SET STOPCODE=+Y
WRITE !
+33 ;
+34 ;
KILL DIR
SET DIR(0)="S^A:Add;D:Delete"
SET DIR("A")="Clinics matching stop code"
SET DIR("B")="A"
DO ^DIR
if Y=""
QUIT
if $DATA(DIRUT)
QUIT
SET ACTION=Y
WRITE !
+35 ;
+36 ;
IF ACTION="A"
Begin DoDot:2
+37 ;
SET IEN=0
FOR
SET IEN=$ORDER(^SC("AST",STOPCODE,IEN))
if 'IEN
QUIT
WRITE !,$$GET1^DIQ(44,IEN,.01)
Begin DoDot:3
+38 ;
+39 ; ALREADY ON FILE
IF $DATA(^EHRM(1610,"B",IEN))
WRITE "...Already in EHRM ACTIVE CLINIC file."
QUIT
+40 ;
SET INACTDT=$$GET1^DIQ(44,IEN,2505,"I")
SET REACTDT=$$GET1^DIQ(44,IEN,2506,"I")
+41 ;
IF INACTDT'=""
IF INACTDT'>DT
IF REACTDT=""!(REACTDT>DT)
WRITE "...Inactive. Skipped."
QUIT
+42 ;
+43 ;
KILL DIC
SET DIC=1610
SET DIC(0)="L"
SET X=IEN
DO FILE^DICN
WRITE "...Added"
End DoDot:3
+44 ;
WRITE !
End DoDot:2
+45 ;
+46 ;
IF ACTION="D"
Begin DoDot:2
+47 ;
SET IEN=0
FOR
SET IEN=$ORDER(^SC("AST",STOPCODE,IEN))
if 'IEN
QUIT
WRITE !,$$GET1^DIQ(44,IEN,.01)
Begin DoDot:3
+48 ;
+49 ;
IF '$DATA(^EHRM(1610,"B",IEN))
WRITE "...Not in file."
QUIT
+50 ;
+51 ;
KILL DIK
SET DIK=^DIC(1610,0,"GL")
SET DA=$ORDER(^EHRM(1610,"B",IEN,0))
DO ^DIK
WRITE "...Deleted"
End DoDot:3
End DoDot:2
End DoDot:1
QUIT
+52 ;
+53 ;
QUIT
+54 ;
