SDECRT ;ALB/SAT - VISTA SCHEDULING RPCS ;JAN 15, 2016
;;5.3;Scheduling;**627**;Aug 13, 1993;Build 249
;
Q
;
WISD(DFN,SDATE,BSDMODE,BSDDEV,BSDNHS) ;PEP; print routing slip for walkin/same day appt
; Check for DFN if user enters by Clinic, but does not select a Pt
N DIR,DIV,ORDER,%ZIS
N SDREP,SDSTART,SDX,Y
I +$G(DFN)=0 Q
;
N %DIS,DGPGM,VAR,VAR1,DEV,POP
S SDX="ALL",ORDER="",SDREP=0,SDSTART="",DIV=$$DIV^SDECU
;
S VAR="DIV^ORDER^SDX^SDATE^DFN^SDREP^SDSTART^BSDMODE^BSDNHS"
S VAR1="DIV;ORDER;SDX;SDATE;DFN;SDREP;SDSTART;BSDMODE;BSDNHS"
;
S DGPGM="SINGLE^SDECROUT"
I $G(BSDDEV)]"" D ZIS^SDECF("F","SINGLE^BSDROUT","ROUTING SLIP",VAR1,BSDDEV) Q
S DEV=$S(BSDMODE="CR":".05",1:".11") ;default printer fields
S BDGDEV=$$GET1^DIQ(9009020.2,$$DIV^SDECU,DEV)
I BDGDEV="" K BDGDEV Q
S %ZIS("A")="FILE ROOM PRINTER: " D ZIS^DGUTQ I POP D END^SDROUT1 Q
D SINGLE
Q
;
SINGLE ;EP; queued entry point for single routing slips
; called by WISD subroutine
U IO K ^TMP("SDRS",$J)
NEW BSDT,CLN,IEN,BSDMOD2
;
; find all appts for patient
I BSDMODE="CR" S BSDMOD2="CR",BSDMODE=""
S BSDT=SDATE\1
F S BSDT=$O(^DPT(DFN,"S",BSDT)) Q:'BSDT Q:(BSDT\1>SDATE) D
. S CLN=+$G(^DPT(DFN,"S",BSDT,0)) Q:'CLN ;clinic ien
. S IEN=0 F S IEN=$O(^SC(CLN,"S",BSDT,1,IEN)) Q:'IEN Q:$P($G(^SC(CLN,"S",BSDT,1,IEN,0)),U)=DFN
. Q:'IEN ;appt ien in ^sc
. D FIND^SDECRT0(CLN,BSDT,IEN,ORDER,BSDMODE,SDX,SDSTART,"",SDREP,SDATE)
I $D(BSDMOD2) S BSDMODE=BSDMOD2
;
; if no future appts, set something so RS will print
I '$D(^TMP("SDRS",$J)) S ^TMP("SDRS",$J,$$GET1^DIQ(2,DFN,.01),$$TERM(DFN),DFN)=""
;
D PRINT^SDECRT1(ORDER,SDATE,SDX,SDSTART,"",SDREP)
Q
;
TERM(PAT) ; returns chart # in terminal digit format
NEW N,T
S N=$$HRCN^SDECF2(PAT,$G(DUZ(2))) ;chart #
S T=$$HRCNT^SDECF2(N) ;terminal digit format
I $$GET1^DIQ(9009020.2,+$$DIV^SDECU,.18)="NO" D
. S T=$$HRCND^SDECF2(N) ;use chart # per site param
Q T
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDECRT 2048 printed Dec 13, 2024@02:52:36 Page 2
SDECRT ;ALB/SAT - VISTA SCHEDULING RPCS ;JAN 15, 2016
+1 ;;5.3;Scheduling;**627**;Aug 13, 1993;Build 249
+2 ;
+3 QUIT
+4 ;
WISD(DFN,SDATE,BSDMODE,BSDDEV,BSDNHS) ;PEP; print routing slip for walkin/same day appt
+1 ; Check for DFN if user enters by Clinic, but does not select a Pt
+2 NEW DIR,DIV,ORDER,%ZIS
+3 NEW SDREP,SDSTART,SDX,Y
+4 IF +$GET(DFN)=0
QUIT
+5 ;
+6 NEW %DIS,DGPGM,VAR,VAR1,DEV,POP
+7 SET SDX="ALL"
SET ORDER=""
SET SDREP=0
SET SDSTART=""
SET DIV=$$DIV^SDECU
+8 ;
+9 SET VAR="DIV^ORDER^SDX^SDATE^DFN^SDREP^SDSTART^BSDMODE^BSDNHS"
+10 SET VAR1="DIV;ORDER;SDX;SDATE;DFN;SDREP;SDSTART;BSDMODE;BSDNHS"
+11 ;
+12 SET DGPGM="SINGLE^SDECROUT"
+13 IF $GET(BSDDEV)]""
DO ZIS^SDECF("F","SINGLE^BSDROUT","ROUTING SLIP",VAR1,BSDDEV)
QUIT
+14 ;default printer fields
SET DEV=$SELECT(BSDMODE="CR":".05",1:".11")
+15 SET BDGDEV=$$GET1^DIQ(9009020.2,$$DIV^SDECU,DEV)
+16 IF BDGDEV=""
KILL BDGDEV
QUIT
+17 SET %ZIS("A")="FILE ROOM PRINTER: "
DO ZIS^DGUTQ
IF POP
DO END^SDROUT1
QUIT
+18 DO SINGLE
+19 QUIT
+20 ;
SINGLE ;EP; queued entry point for single routing slips
+1 ; called by WISD subroutine
+2 USE IO
KILL ^TMP("SDRS",$JOB)
+3 NEW BSDT,CLN,IEN,BSDMOD2
+4 ;
+5 ; find all appts for patient
+6 IF BSDMODE="CR"
SET BSDMOD2="CR"
SET BSDMODE=""
+7 SET BSDT=SDATE\1
+8 FOR
SET BSDT=$ORDER(^DPT(DFN,"S",BSDT))
if 'BSDT
QUIT
if (BSDT\1>SDATE)
QUIT
Begin DoDot:1
+9 ;clinic ien
SET CLN=+$GET(^DPT(DFN,"S",BSDT,0))
if 'CLN
QUIT
+10 SET IEN=0
FOR
SET IEN=$ORDER(^SC(CLN,"S",BSDT,1,IEN))
if 'IEN
QUIT
if $PIECE($GET(^SC(CLN,"S",BSDT,1,IEN,0)),U)=DFN
QUIT
+11 ;appt ien in ^sc
if 'IEN
QUIT
+12 DO FIND^SDECRT0(CLN,BSDT,IEN,ORDER,BSDMODE,SDX,SDSTART,"",SDREP,SDATE)
End DoDot:1
+13 IF $DATA(BSDMOD2)
SET BSDMODE=BSDMOD2
+14 ;
+15 ; if no future appts, set something so RS will print
+16 IF '$DATA(^TMP("SDRS",$JOB))
SET ^TMP("SDRS",$JOB,$$GET1^DIQ(2,DFN,.01),$$TERM(DFN),DFN)=""
+17 ;
+18 DO PRINT^SDECRT1(ORDER,SDATE,SDX,SDSTART,"",SDREP)
+19 QUIT
+20 ;
TERM(PAT) ; returns chart # in terminal digit format
+1 NEW N,T
+2 ;chart #
SET N=$$HRCN^SDECF2(PAT,$GET(DUZ(2)))
+3 ;terminal digit format
SET T=$$HRCNT^SDECF2(N)
+4 IF $$GET1^DIQ(9009020.2,+$$DIV^SDECU,.18)="NO"
Begin DoDot:1
+5 ;use chart # per site param
SET T=$$HRCND^SDECF2(N)
End DoDot:1
+6 QUIT T
