SDDPA ;MAN/GRR,ALB/TMP,GXT/SCM - DISPLAY APPOINTMENTS ;7/23/18
;;5.3;Scheduling;**140,334,545,705,739**;Aug 13, 1993;Build 1
;;Per VA Directive 6402, this routine should not be modified.
;;9/5/06KMP
D:'$D(DT) DT^SDUTL K SDACS
RD Q:$D(SDACS) S HDT=DT,APL="",SDRG=0,SDEDT=""
K ^UTILITY($J) W ! S SDEND=0,DIC="^DPT(",DIC(0)="AEQM" D ^DIC G:X=""!(X="^")!($D(DTOUT)) END I Y<0 W !,*7,*7,"PATIENT NOT FOUND",*7,*7 G RD
S DA=+Y,DFN=DA,NAME=$P(Y,"^",2)
RD1 ; If "Exclude Administrative Clinics" parameter (ADMIN API) is set to "YES"
; then user will be prompted if they want to exclude the administrative
; clinics from the Appointment List. SD*5.3*705
N SDEXCLUD S SDEXCLUD=""
I $$ADMIN D Q:'$G(DFN) ;*739 quit if no pat exists
. S %=2,DTOUT=0 W !,"Do you want to exclude Administrative Clinic appointments" D YN^DICN G:%<0!$T RD I '% W !,"Respond YES or NO" G RD1
. S SDEXCLUD=%
RD2 S %=1,DTOUT=0 W !,"Do you want to see only pending appointments" D YN^DICN G:%<0!$T RD I '% W !,"Respond YES or NO" G RD2
S (SDONE,POP)=0,SDYN=% D:SDYN=2 RANGE G:POP RD
; DGVAR updated to include SDEXCLUD variable SD*5.3*705
S DGVAR="BEGDATE^ENDATE^SDYN^DFN^HDT^APL^SDRG^SDONE^SDEDT^SDEND^SDEXCLUD",DGPGM="1^SDDPA" D ZIS^DGUTQ G:POP SDDPA D 1 G SDDPA
1 U IO S SDSTR=$S($D(^DPT(DFN,0)):^(0),1:""),SDN=$P(SDSTR,U)
; Displays/prints the site entered additional header text at
; the beginning of report. SD*5.3*705
D ADDHDR(1)
S SDSSN=$P(SDSTR,U,9),%DT="R",X="N" D ^%DT
W !,"APPOINTMENTS FOR: ",$E(SDN,1,22)
; Truncate SSN to Display Only Last Four Digits. SD*5.3*705
W ?42,"***","-","**","-",$E(SDSSN,6,9)
W ?54,"PRINTED: ",$$FMTE^XLFDT(Y,"5")
; Displays/prints the site entered additional header text after
; the second line of report. SD*5.3*705
D ADDHDR(0) G:$G(SDEND)>0 END
; Display PC Provider, Associate and Team. SD*5.3*705
W !!,$$PCLINE^SDPPTEM(DFN)
I ($Y+4)>IOSL,$E(IOST,1,2)="C-" D OUT^SDUTL W:'SDEND @IOF G:SDEND>0 END
G:$O(^DPT(DFN,"S",HDT))'>0 NO S NDT=HDT,L=0
;
EN1 ;
; Output updated to include physical location of the clinic and
; as appropriate excludes administrative clinics. SD*5.3*705
F J=1:1 S NDT=$O(^DPT(DFN,"S",NDT)) Q:NDT'>0!(SDRG&(NDT>SDEDT)) D
. I $S($P(^DPT(DFN,"S",NDT,0),"^",2)']"":1,$P(^DPT(DFN,"S",NDT,0),"^",2)["NT":1,$P(^DPT(DFN,"S",NDT,0),"^",2)["I":1,SDRG:1,1:0) D
. . D CHKSO,FLEN Q:$$EXCLUDE(SDEXCLUD,SDSCIEN)>0 S ^UTILITY($J,L)=NDT_"^"_SC_"^"_COV_"^"_APL_"^^"_SDNS_"^"_SDBY_"^"_SCRM
G:L'>0 NO
S ZZ=0 F S ZZ=$O(^UTILITY($J,ZZ)) Q:ZZ'>0 S AT=$S($P(^UTILITY($J,ZZ),"^",2)'?.N:1,1:0) W !! S Y=$P($P(^(ZZ),"^",1),".",1) D DT^SDM0 S X=$P(^(ZZ),"^",1) X ^DD("FUNC",2,1) W " ",$J(X,8) D MORE Q:SDEND
G END
;
NO W !,"NO ",$S('SDRG:"PENDING APPOINTMENTS",1:"APPOINTMENTS FOUND DURING RANGE SELECTED")
G END
RANGE D DATE^SDUTL Q:POP S HDT=BEGDATE,SDEDT=ENDDATE_.9,SDRG=1,SDONE=0
I $D(^DPT(DFN,"ARCH","AB","S")) S X=$O(^("S",0)) I $D(^DPT(DFN,"ARCH",X)) F A=0:0 S A=$O(^DPT(DFN,"ARCH",X,1,A)) Q:A'>0 S Z=^(A,0),B=$P(Z,"^",3),C=$P(Z,"^",4),D=$P(Z,"^",5),E=$P(Z,"^",2) I B'<HDT&(B'>SDEDT)!(C'<HDT&(C'>SDEDT)) D ARCH
Q
ARCH I 'SDONE W @IOF,!!,"This patient has archived appts during this time period:",! W !,?3,"ARCHIVED DATE RANGE # APPOINTMENTS TAPE # DATE ARCHIVED",!
W !,?3,$S(B:$$FMTE^XLFDT(B,"5D"),1:""),"-",$S(C:$$FMTE^XLFDT(C,"5D"),1:""),?32,+D,?45,E S Y=+Z D DTS^SDUTL W ?59,Y
S SDONE=1 K B,C,D,E,Z Q
FLEN ;following code changed with SD/545
;Set stop code IEN and clinic address. SD*5.3*705
S SC=+^DPT(DFN,"S",NDT,0),L=L+1,COV=$S($P(^DPT(DFN,"S",NDT,0),U,11)=1:" (COLLATERAL) ",1:""),SCNODE=$G(^SC(SC,0)),SDSCIEN=$P(SCNODE,U,7),SCRM=$P(SCNODE,U,11) I $D(^SC(SC,"S",NDT)) F ZL=0:0 S ZL=$O(^SC(SC,"S",NDT,1,ZL)) Q:ZL="" D
.N POP S POP=0
.I '$D(^SC(SC,"S",NDT,1,ZL,0)) I $D(^SC(SC,"S",NDT,1,ZL,"C")) D RESET I POP S APL=APLEN Q
.I +^SC(SC,"S",NDT,1,ZL,0)=DFN S APL=$P(^SC(SC,"S",NDT,1,ZL,0),U,2)
K POP,APLEN
Q
;
RESET ;reset zero node of appt multiple in file #44 if values are known SD/545
I 'DFN S POP=1 Q
I '$D(^DPT(DFN,"S",NDT,0)) S POP=1 Q
I '$G(^DPT(DFN,"S",NDT,0)) S POP=1 Q
I '+^DPT(DFN,"S",NDT,0) S POP=1 Q
I $P(^DPT(DFN,"S",NDT,0),U,2)="CA"!($P(^(0),U,2)="PC")!($P(^(0),U,2)="PCA") K ^SC(SC,"S",NDT,1,ZL,"C") S APLEN=+^SC(SC,"SL"),POP=1 Q
S (NODE,APLEN,STAT1)=""
S NODE=^DPT(DFN,"S",NDT,0),APLEN=+^SC(SC,"SL"),STAT1=$P(NODE,U,2)
S DA=ZL,DA(1)=NDT,DA(2)=SC
S DIE="^SC("_DA(2)_",""S"","_DA(1)_",1,"
S DR=".01///^S X=DFN;1///^S X=APLEN" D ^DIE
S SC=DA(2)
S $P(^SC(SC,"S",NDT,1,ZL,0),U,6)=$P(NODE,U,18)
S $P(^SC(SC,"S",NDT,1,ZL,0),U,7)=$P(NODE,U,19)
I STAT1="C" S $P(^SC(SC,"S",NDT,1,ZL,0),U,9)=STAT1
K NODE,APLEN,STAT1,DA,DR,DIE
Q
;
CHKSO S SDNS=$S($P(^DPT(DFN,"S",NDT,0),"^",2)']""!($P(^(0),"^",2)["I"):"",1:$P(^(0),"^",2)),SDBY="" I SDNS["C" S SDU=+$P(^DPT(DFN,"S",NDT,0),"^",12),SDBY=$S($D(^VA(200,SDU,0)):$P(^(0),"^",1),1:SDU) K SDU
F SDJ=3,4,5 I $P(^DPT(DFN,"S",NDT,0),"^",SDJ)]"" S L=L+1,^UTILITY($J,L)=$P(^(0),"^",SDJ)_"^"_$S(SDJ=3:"LAB",SDJ=4:"XRAY",1:"EKG")_"^0^0"
Q
END W ! K %DT,A,C,APL,AT,BEGDATE,ENDDATE,COV,DA,DFN,DGPGM,DGVAR,DIPGM,DIC,HDT,J,L,NAME,NDT,POP,SC,SDED,SDBD,SDBY,SDEDT,SDEND,SDJ,SDN,SDNS,SDONE,SDRG,SDSSN,SDSTR,SDYN
K X,Y,ZL,ZX,ZZ,^UTILITY($J),SCNODE,SDSCIEN,SCRM,DTOUT ;Kill the new variables added with SD*5.3*705
D CLOSE^DGUTQ
Q
MORE I AT W ?36,$P(^UTILITY($J,ZZ),"^",2) I ($Y+4)>IOSL,$E(IOST,1,2)="C-" D OUT^SDUTL Q:SDEND W @IOF
Q:AT
W " (",$P(^UTILITY($J,ZZ),"^",4)," MINUTES) ",$S($D(^SC(+$P(^UTILITY($J,ZZ),"^",2),0)):$P(^SC(+$P(^UTILITY($J,ZZ),"^",2),0),"^"),1:"Deleted Clinic"),$P(^UTILITY($J,ZZ),"^",3)," ",$P(^(ZZ),"^",5),?60,$P(^(ZZ),"^",8) ;SD*5.3*705
I $P(^(ZZ),"^",6)]"" W !,$S($P(^(ZZ),"^",6)["NT":" *** ACTION REQUIRED ***",$P(^(ZZ),"^",6)["N":" *** NO-SHOW ***",$P(^(ZZ),"^",6)["C":" *** CANCELLED BY "_$P(^(ZZ),"^",7)_" ***",1:"") ;NAKED REFERENCE - ^UTILITY($J,ZZ)
I ($Y+4)>IOSL,IOST?1"C-".E D OUT^SDUTL W:'SDEND @IOF
Q
;
ADDHDR(SDLOC) ;
; Added with patch SD*5.3*705
; The SDLOC variable is passed to delineate which entered text should
; be printed.
;
; Quit if there is no additional text for user based on their defined
; location (DUZ(2))
Q:$D(^SD(404.91,1,2,"B",+$G(DUZ(2))))'>0
N SITEIEN,TXTIEN,FIRST,HDRTXT,COLNUM
S SITEIEN=$O(^SD(404.91,1,2,"B",+$G(DUZ(2)),0))
; Quit if there is no Header Text for the user's defined location in
; the ADDITIONAL HEADER TEXT (1.3) multiple subfile of the SCHEDULING
; PARAMETER (#404.91) file
Q:SITEIEN'>0
S TXTIEN=0,FIRST=1
F S TXTIEN=$O(^SD(404.91,1,2,"C",+$G(SDLOC),SITEIEN,TXTIEN)) Q:TXTIEN'>0 D Q:$G(SDEND)>0
. ; Execute a top of form operation for current device if header
. ; text is to start on first line of output
. I FIRST=1,$G(SDLOC)=1 W @IOF S FIRST=0
. ; Execute a line feed operation for current device if header
. ; text is to start after Patient Data line
. I FIRST=1,$G(SDLOC)'>0 W ! S FIRST=0
. S HDRTXT=$P($G(^SD(404.91,1,2,SITEIEN,1,TXTIEN,0)),U,1)
. S COLNUM=$S(SDLOC=1:(80-$L(HDRTXT))/2,1:1)
. W !,?COLNUM,HDRTXT
. ; If text is to start after patient name and the current additional
. ; header line exceeds allowed body text, then execute a top of form
. ; operation
. I SDLOC'>0,($Y+4)>IOSL,$E(IOST,1,2)="C-" D OUT^SDUTL W:'SDEND @IOF
; Execute a line feed operation for current device if header
; text is to start on first line of output and there is header text
W:(SDLOC>0&($G(HDRTXT)]"")) !
Q
;
ADMIN() ;
; This API gets the value of the "EXCLUDE ADMIN CLINICS" (#1.2)
; field in the SCHEDULING PARAMETERS (404.91) file.
; Added with patch SD*5.3*705
N DIQ,DIC,DA,DR
S DIQ(0)="I",DIC=404.91,DA=1,DR="1.2"
Q +$$GET1^DIQ(DIC,DA_",",DR,"I")
;
EXCLUDE(SDEXCLUD,SDSCIEN) ;
; This API returns a 1 if the user responded to the "Exclude
; Administrative Clinics" with a yes SDEXCLUD variable and
; if the appointment clinic has a Stop Code Number equals 674.
; The values of SDEXCLUD may be based on the YN^DICN call for future maintainability.
; NOTE: The SDSCIEN variable is the pointer value of STOP CODE
; NUMBER (#8) FIELD in the HOSPITAL LOCATION(#44) FILE. Using
; this pointer value a check is done on the value in the REPORTING
; STOP CODE (#1) field in the CLINIC STOP (#40.7) file to see if it
; equals 674.
; Added with patch SD*5.3*705
Q $S((+$G(SDEXCLUD)=1)&($P($G(^DIC(40.7,+$G(SDSCIEN),0)),U,2)=674):1,1:0)
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDDPA 8471 printed Oct 16, 2024@18:50:20 Page 2
SDDPA ;MAN/GRR,ALB/TMP,GXT/SCM - DISPLAY APPOINTMENTS ;7/23/18
+1 ;;5.3;Scheduling;**140,334,545,705,739**;Aug 13, 1993;Build 1
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;9/5/06KMP
+4 if '$DATA(DT)
DO DT^SDUTL
KILL SDACS
RD if $DATA(SDACS)
QUIT
SET HDT=DT
SET APL=""
SET SDRG=0
SET SDEDT=""
+1 KILL ^UTILITY($JOB)
WRITE !
SET SDEND=0
SET DIC="^DPT("
SET DIC(0)="AEQM"
DO ^DIC
if X=""!(X="^")!($DATA(DTOUT))
GOTO END
IF Y<0
WRITE !,*7,*7,"PATIENT NOT FOUND",*7,*7
GOTO RD
+2 SET DA=+Y
SET DFN=DA
SET NAME=$PIECE(Y,"^",2)
RD1 ; If "Exclude Administrative Clinics" parameter (ADMIN API) is set to "YES"
+1 ; then user will be prompted if they want to exclude the administrative
+2 ; clinics from the Appointment List. SD*5.3*705
+3 NEW SDEXCLUD
SET SDEXCLUD=""
+4 ;*739 quit if no pat exists
IF $$ADMIN
Begin DoDot:1
+5 SET %=2
SET DTOUT=0
WRITE !,"Do you want to exclude Administrative Clinic appointments"
DO YN^DICN
if %<0!$TEST
GOTO RD
IF '%
WRITE !,"Respond YES or NO"
GOTO RD1
+6 SET SDEXCLUD=%
End DoDot:1
if '$GET(DFN)
QUIT
RD2 SET %=1
SET DTOUT=0
WRITE !,"Do you want to see only pending appointments"
DO YN^DICN
if %<0!$TEST
GOTO RD
IF '%
WRITE !,"Respond YES or NO"
GOTO RD2
+1 SET (SDONE,POP)=0
SET SDYN=%
if SDYN=2
DO RANGE
if POP
GOTO RD
+2 ; DGVAR updated to include SDEXCLUD variable SD*5.3*705
+3 SET DGVAR="BEGDATE^ENDATE^SDYN^DFN^HDT^APL^SDRG^SDONE^SDEDT^SDEND^SDEXCLUD"
SET DGPGM="1^SDDPA"
DO ZIS^DGUTQ
if POP
GOTO SDDPA
DO 1
GOTO SDDPA
1 USE IO
SET SDSTR=$SELECT($DATA(^DPT(DFN,0)):^(0),1:"")
SET SDN=$PIECE(SDSTR,U)
+1 ; Displays/prints the site entered additional header text at
+2 ; the beginning of report. SD*5.3*705
+3 DO ADDHDR(1)
+4 SET SDSSN=$PIECE(SDSTR,U,9)
SET %DT="R"
SET X="N"
DO ^%DT
+5 WRITE !,"APPOINTMENTS FOR: ",$EXTRACT(SDN,1,22)
+6 ; Truncate SSN to Display Only Last Four Digits. SD*5.3*705
+7 WRITE ?42,"***","-","**","-",$EXTRACT(SDSSN,6,9)
+8 WRITE ?54,"PRINTED: ",$$FMTE^XLFDT(Y,"5")
+9 ; Displays/prints the site entered additional header text after
+10 ; the second line of report. SD*5.3*705
+11 DO ADDHDR(0)
if $GET(SDEND)>0
GOTO END
+12 ; Display PC Provider, Associate and Team. SD*5.3*705
+13 WRITE !!,$$PCLINE^SDPPTEM(DFN)
+14 IF ($Y+4)>IOSL
IF $EXTRACT(IOST,1,2)="C-"
DO OUT^SDUTL
if 'SDEND
WRITE @IOF
if SDEND>0
GOTO END
+15 if $ORDER(^DPT(DFN,"S",HDT))'>0
GOTO NO
SET NDT=HDT
SET L=0
+16 ;
EN1 ;
+1 ; Output updated to include physical location of the clinic and
+2 ; as appropriate excludes administrative clinics. SD*5.3*705
+3 FOR J=1:1
SET NDT=$ORDER(^DPT(DFN,"S",NDT))
if NDT'>0!(SDRG&(NDT>SDEDT))
QUIT
Begin DoDot:1
+4 IF $SELECT($PIECE(^DPT(DFN,"S",NDT,0),"^",2)']"":1,$PIECE(^DPT(DFN,"S",NDT,0),"^",2)["NT":1,$PIECE(^DPT(DFN,"S",NDT,0),"^",2)["I":1,SDRG:1,1:0)
Begin DoDot:2
+5 DO CHKSO
DO FLEN
if $$EXCLUDE(SDEXCLUD,SDSCIEN)>0
QUIT
SET ^UTILITY($JOB,L)=NDT_"^"_SC_"^"_COV_"^"_APL_"^^"_SDNS_"^"_SDBY_"^"_SCRM
End DoDot:2
End DoDot:1
+6 if L'>0
GOTO NO
+7 SET ZZ=0
FOR
SET ZZ=$ORDER(^UTILITY($JOB,ZZ))
if ZZ'>0
QUIT
SET AT=$SELECT($PIECE(^UTILITY($JOB,ZZ),"^",2)'?.N:1,1:0)
WRITE !!
SET Y=$PIECE($PIECE(^(ZZ),"^",1),".",1)
DO DT^SDM0
SET X=$PIECE(^(ZZ),"^",1)
XECUTE ^DD("FUNC",2,1)
WRITE " ",$JUSTIFY(X,8)
DO MORE
if SDEND
QUIT
+8 GOTO END
+9 ;
NO WRITE !,"NO ",$SELECT('SDRG:"PENDING APPOINTMENTS",1:"APPOINTMENTS FOUND DURING RANGE SELECTED")
+1 GOTO END
RANGE DO DATE^SDUTL
if POP
QUIT
SET HDT=BEGDATE
SET SDEDT=ENDDATE_.9
SET SDRG=1
SET SDONE=0
+1 IF $DATA(^DPT(DFN,"ARCH","AB","S"))
SET X=$ORDER(^("S",0))
IF $DATA(^DPT(DFN,"ARCH",X))
FOR A=0:0
SET A=$ORDER(^DPT(DFN,"ARCH",X,1,A))
if A'>0
QUIT
SET Z=^(A,0)
SET B=$PIECE(Z,"^",3)
SET C=$PIECE(Z,"^",4)
SET D=$PIECE(Z,"^",5)
SET E=$PIECE(Z,"^",2)
IF B'<HDT&(B'>SDEDT)!(C'<HDT&(C'>SDEDT))
DO ARCH
+2 QUIT
ARCH IF 'SDONE
WRITE @IOF,!!,"This patient has archived appts during this time period:",!
WRITE !,?3,"ARCHIVED DATE RANGE # APPOINTMENTS TAPE # DATE ARCHIVED",!
+1 WRITE !,?3,$SELECT(B:$$FMTE^XLFDT(B,"5D"),1:""),"-",$SELECT(C:$$FMTE^XLFDT(C,"5D"),1:""),?32,+D,?45,E
SET Y=+Z
DO DTS^SDUTL
WRITE ?59,Y
+2 SET SDONE=1
KILL B,C,D,E,Z
QUIT
FLEN ;following code changed with SD/545
+1 ;Set stop code IEN and clinic address. SD*5.3*705
+2 SET SC=+^DPT(DFN,"S",NDT,0)
SET L=L+1
SET COV=$SELECT($PIECE(^DPT(DFN,"S",NDT,0),U,11)=1:" (COLLATERAL) ",1:"")
SET SCNODE=$GET(^SC(SC,0))
SET SDSCIEN=$PIECE(SCNODE,U,7)
SET SCRM=$PIECE(SCNODE,U,11)
IF $DATA(^SC(SC,"S",NDT))
FOR ZL=0:0
SET ZL=$ORDER(^SC(SC,"S",NDT,1,ZL))
if ZL=""
QUIT
Begin DoDot:1
+3 NEW POP
SET POP=0
+4 IF '$DATA(^SC(SC,"S",NDT,1,ZL,0))
IF $DATA(^SC(SC,"S",NDT,1,ZL,"C"))
DO RESET
IF POP
SET APL=APLEN
QUIT
+5 IF +^SC(SC,"S",NDT,1,ZL,0)=DFN
SET APL=$PIECE(^SC(SC,"S",NDT,1,ZL,0),U,2)
End DoDot:1
+6 KILL POP,APLEN
+7 QUIT
+8 ;
RESET ;reset zero node of appt multiple in file #44 if values are known SD/545
+1 IF 'DFN
SET POP=1
QUIT
+2 IF '$DATA(^DPT(DFN,"S",NDT,0))
SET POP=1
QUIT
+3 IF '$GET(^DPT(DFN,"S",NDT,0))
SET POP=1
QUIT
+4 IF '+^DPT(DFN,"S",NDT,0)
SET POP=1
QUIT
+5 IF $PIECE(^DPT(DFN,"S",NDT,0),U,2)="CA"!($PIECE(^(0),U,2)="PC")!($PIECE(^(0),U,2)="PCA")
KILL ^SC(SC,"S",NDT,1,ZL,"C")
SET APLEN=+^SC(SC,"SL")
SET POP=1
QUIT
+6 SET (NODE,APLEN,STAT1)=""
+7 SET NODE=^DPT(DFN,"S",NDT,0)
SET APLEN=+^SC(SC,"SL")
SET STAT1=$PIECE(NODE,U,2)
+8 SET DA=ZL
SET DA(1)=NDT
SET DA(2)=SC
+9 SET DIE="^SC("_DA(2)_",""S"","_DA(1)_",1,"
+10 SET DR=".01///^S X=DFN;1///^S X=APLEN"
DO ^DIE
+11 SET SC=DA(2)
+12 SET $PIECE(^SC(SC,"S",NDT,1,ZL,0),U,6)=$PIECE(NODE,U,18)
+13 SET $PIECE(^SC(SC,"S",NDT,1,ZL,0),U,7)=$PIECE(NODE,U,19)
+14 IF STAT1="C"
SET $PIECE(^SC(SC,"S",NDT,1,ZL,0),U,9)=STAT1
+15 KILL NODE,APLEN,STAT1,DA,DR,DIE
+16 QUIT
+17 ;
CHKSO SET SDNS=$SELECT($PIECE(^DPT(DFN,"S",NDT,0),"^",2)']""!($PIECE(^(0),"^",2)["I"):"",1:$PIECE(^(0),"^",2))
SET SDBY=""
IF SDNS["C"
SET SDU=+$PIECE(^DPT(DFN,"S",NDT,0),"^",12)
SET SDBY=$SELECT($DATA(^VA(200,SDU,0)):$PIECE(^(0),"^",1),1:SDU)
KILL SDU
+1 FOR SDJ=3,4,5
IF $PIECE(^DPT(DFN,"S",NDT,0),"^",SDJ)]""
SET L=L+1
SET ^UTILITY($JOB,L)=$PIECE(^(0),"^",SDJ)_"^"_$SELECT(SDJ=3:"LAB",SDJ=4:"XRAY",1:"EKG")_"^0^0"
+2 QUIT
END WRITE !
KILL %DT,A,C,APL,AT,BEGDATE,ENDDATE,COV,DA,DFN,DGPGM,DGVAR,DIPGM,DIC,HDT,J,L,NAME,NDT,POP,SC,SDED,SDBD,SDBY,SDEDT,SDEND,SDJ,SDN,SDNS,SDONE,SDRG,SDSSN,SDSTR,SDYN
+1 ;Kill the new variables added with SD*5.3*705
KILL X,Y,ZL,ZX,ZZ,^UTILITY($JOB),SCNODE,SDSCIEN,SCRM,DTOUT
+2 DO CLOSE^DGUTQ
+3 QUIT
MORE IF AT
WRITE ?36,$PIECE(^UTILITY($JOB,ZZ),"^",2)
IF ($Y+4)>IOSL
IF $EXTRACT(IOST,1,2)="C-"
DO OUT^SDUTL
if SDEND
QUIT
WRITE @IOF
+1 if AT
QUIT
+2 ;SD*5.3*705
WRITE " (",$PIECE(^UTILITY($JOB,ZZ),"^",4)," MINUTES) ",$SELECT($DATA(^SC(+$PIECE(^UTILITY($JOB,ZZ),"^",2),0)):$PIECE(^SC(+$PIECE(^UTILITY($JOB,ZZ),"^",2),0),"^"),1:"Deleted Clinic"),$PIECE(^UTILITY(...
... $JOB,ZZ),"^",3)," ",$PIECE(^(ZZ),"^",5),?60,$PIECE(^(ZZ),"^",8)
+3 ;NAKED REFERENCE - ^UTILITY($J,ZZ)
IF $PIECE(^(ZZ),"^",6)]""
WRITE !,$SELECT($PIECE(^(ZZ),"^",6)["NT":" *** ACTION REQUIRED ***",$PIECE(^(ZZ),"^",6)["N":" *** NO-SHOW ***",$PIECE(^(ZZ),"^",6)["C":" *** CANCELLED BY "_$PIECE(^(ZZ),"^",7)_" ***",1:"")
+4 IF ($Y+4)>IOSL
IF IOST?1"C-".E
DO OUT^SDUTL
if 'SDEND
WRITE @IOF
+5 QUIT
+6 ;
ADDHDR(SDLOC) ;
+1 ; Added with patch SD*5.3*705
+2 ; The SDLOC variable is passed to delineate which entered text should
+3 ; be printed.
+4 ;
+5 ; Quit if there is no additional text for user based on their defined
+6 ; location (DUZ(2))
+7 if $DATA(^SD(404.91,1,2,"B",+$GET(DUZ(2))))'>0
QUIT
+8 NEW SITEIEN,TXTIEN,FIRST,HDRTXT,COLNUM
+9 SET SITEIEN=$ORDER(^SD(404.91,1,2,"B",+$GET(DUZ(2)),0))
+10 ; Quit if there is no Header Text for the user's defined location in
+11 ; the ADDITIONAL HEADER TEXT (1.3) multiple subfile of the SCHEDULING
+12 ; PARAMETER (#404.91) file
+13 if SITEIEN'>0
QUIT
+14 SET TXTIEN=0
SET FIRST=1
+15 FOR
SET TXTIEN=$ORDER(^SD(404.91,1,2,"C",+$GET(SDLOC),SITEIEN,TXTIEN))
if TXTIEN'>0
QUIT
Begin DoDot:1
+16 ; Execute a top of form operation for current device if header
+17 ; text is to start on first line of output
+18 IF FIRST=1
IF $GET(SDLOC)=1
WRITE @IOF
SET FIRST=0
+19 ; Execute a line feed operation for current device if header
+20 ; text is to start after Patient Data line
+21 IF FIRST=1
IF $GET(SDLOC)'>0
WRITE !
SET FIRST=0
+22 SET HDRTXT=$PIECE($GET(^SD(404.91,1,2,SITEIEN,1,TXTIEN,0)),U,1)
+23 SET COLNUM=$SELECT(SDLOC=1:(80-$LENGTH(HDRTXT))/2,1:1)
+24 WRITE !,?COLNUM,HDRTXT
+25 ; If text is to start after patient name and the current additional
+26 ; header line exceeds allowed body text, then execute a top of form
+27 ; operation
+28 IF SDLOC'>0
IF ($Y+4)>IOSL
IF $EXTRACT(IOST,1,2)="C-"
DO OUT^SDUTL
if 'SDEND
WRITE @IOF
End DoDot:1
if $GET(SDEND)>0
QUIT
+29 ; Execute a line feed operation for current device if header
+30 ; text is to start on first line of output and there is header text
+31 if (SDLOC>0&($GET(HDRTXT)]""))
WRITE !
+32 QUIT
+33 ;
ADMIN() ;
+1 ; This API gets the value of the "EXCLUDE ADMIN CLINICS" (#1.2)
+2 ; field in the SCHEDULING PARAMETERS (404.91) file.
+3 ; Added with patch SD*5.3*705
+4 NEW DIQ,DIC,DA,DR
+5 SET DIQ(0)="I"
SET DIC=404.91
SET DA=1
SET DR="1.2"
+6 QUIT +$$GET1^DIQ(DIC,DA_",",DR,"I")
+7 ;
EXCLUDE(SDEXCLUD,SDSCIEN) ;
+1 ; This API returns a 1 if the user responded to the "Exclude
+2 ; Administrative Clinics" with a yes SDEXCLUD variable and
+3 ; if the appointment clinic has a Stop Code Number equals 674.
+4 ; The values of SDEXCLUD may be based on the YN^DICN call for future maintainability.
+5 ; NOTE: The SDSCIEN variable is the pointer value of STOP CODE
+6 ; NUMBER (#8) FIELD in the HOSPITAL LOCATION(#44) FILE. Using
+7 ; this pointer value a check is done on the value in the REPORTING
+8 ; STOP CODE (#1) field in the CLINIC STOP (#40.7) file to see if it
+9 ; equals 674.
+10 ; Added with patch SD*5.3*705
+11 QUIT $SELECT((+$GET(SDEXCLUD)=1)&($PIECE($GET(^DIC(40.7,+$GET(SDSCIEN),0)),U,2)=674):1,1:0)
+12 ;
