GMTSPL ; SLC/JER,KER - Print/Queue HS for Patient Lists ; 02/27/2002 [1/27/05 8:27am]
;;2.7;Health Summary;**7,27,28,30,47,49,70**;Oct 20, 1995;Build 5
;
; External References
; DBIA 10090 ^DIC(4
; DBIA 10039 ^DIC(42
; DBIA 10035 ^DPT(
; DBIA 10035 ^DPT("CN"
; DBIA 10040 ^SC(
; DBIA 16 ^SRF(
; DBIA 641 ^SRF("AOR"
; DBIA 185 ^SRS("B"
; DBIA 10091 ^XMB(1
; DBIA 10000 C^%DTC
; DBIA 10000 NOW^%DTC
; DBIA 10026 ^DIR
; DBIA 183 DFN^PSOSD1
; DBIA 10104 $$UP^XLFSTR
; DBIA 2056 $$GET1^DIQ (file #44)
;
MAIN ; Print/Queue for Patient Lists
;
; Call with:
;
; GMTSTYP = Pointer to file 142
; GMTSSC = Pointer to file 44^Hosp Loc Name^
; Hosp Loc Type^Begin Visit/Surg Date^
; Opt end Visit/Surgery Date
; GMTSSC() = GMTSSC - Array of multiple locations
; [GMPSAP] = Optional flag set to 1 if OP Rx
; Action Profile is to print
;
N MULTLOC,GMTSEXIT S GMTSEXIT=0
I $D(GMTSSC("ALL")) D Q
. N IEN,BEG,END,COR,PRM,RAN,PAT
. S PRM=$G(GMTSSC),BEG=$P(PRM,"^",4),END=$P(PRM,"^",5)
. S RAN=BEG S:$L(END)&($L(RAN)) RAN=RAN_"^"_END S:$L(END)&('$L(RAN)) RAN=END
. S IEN=0 F S IEN=$O(^SC(IEN)) Q:+IEN=0 D Q:$G(GMTSEXIT)["^^"
. . N GMTSSC,NAM S NAM=$$GET1^DIQ(44,(+IEN_","),.01) Q:'$L(NAM)
. . S COR=$$GET1^DIQ(44,(+IEN_","),2,"I") Q:COR="" Q:"WCOR"'[COR
. . S GMTSSC=IEN_"^"_NAM_"^"_COR
. . S:"COR"[COR&($L($G(RAN))) GMTSSC=GMTSSC_"^"_RAN
. . S PAT=$$PAT(GMTSSC) Q:+PAT=0
. . D CTRL
I +$O(GMTSSC(0))'>0 D CTRL
I +$O(GMTSSC(0)) D
. S MULTLOC=0 F S MULTLOC=$O(GMTSSC(MULTLOC)) Q:+MULTLOC'>0!$D(DIROUT) D
. . S GMTSSC=GMTSSC(+MULTLOC) D CTRL
Q
CTRL ; Controls Branching
N DFN,GMTDFN,GMLTYPE,GMTSLTR,GMPNM,PSOPAR,PSONOPG,PSOINST,PSTYPE K ^TMP("GMTSPL",$J) U IO
N GMTSBYE S GMTSBYE=0
S GMLTYPE=$P(GMTSSC,U,3) S:GMLTYPE="C" GMTSBYE=$$CLINIC(GMTSSC) D:GMLTYPE="W" WARD(GMTSSC) D:GMLTYPE="OR" OR(GMTSSC)
I GMTSBYE Q
I $L($P(GMTSSC,U,2)),($E(IOST,1)'="C") S GMTSLTR=$E($P(GMTSSC,U,2),1,10) D ^GMTSLTR
I $O(^TMP("GMTSPL",$J,0))="",$D(GMTSSC("ALL")) W !,"ALL" Q
I $O(^TMP("GMTSPL",$J,0))="" D NOPAT($P(GMTSSC,U,2)) Q
S GMPNM="" F S GMPNM=$O(^TMP("GMTSPL",$J,GMPNM)) Q:(GMPNM="")!($D(DIROUT)) D
. S GMTDFN=0 F S GMTDFN=$O(^TMP("GMTSPL",$J,GMPNM,GMTDFN)) Q:(GMTDFN'>0)!($D(DIROUT)) D
. . N GMDUOUT
. . S DFN=GMTDFN D DRIVER Q:$D(DIROUT)!+$G(GMDUOUT)
. . I +$G(GMPSAP) D
. . . S (PSTYPE,PSONOPG)=1
. . . S $P(PSOPAR,U)=$S($P($G(^GMT(142.99,1,0)),U,5)="Y":1,1:0)
. . . S PSOINST=$S(+$G(PSOINST):PSOINST,1:+$P($G(^DIC(4,+$P($G(^XMB(1,1,"XUS")),U,17),99)),U))
. . . D DFN^PSOSD1,PAGE
K ^TMP("GMTSPL",$J)
Q
PAGE ; Pause at BOP for interactive users
N DIR,X,Y
Q:$E(IOST)'="C"!(IOT="HFS")!((IOSL>998)&($G(GMPAT(+$O(GMPAT(""),-1)))'=$G(DFN)))
I IOSL>($Y+5) F W ! Q:IOSL<($Y+6)!($Y'<22)
S DIR(0)="FO^1:1",DIR("A")="Press RETURN to continue or '^' to exit"
S DIR("?")="Enter '^' to quit present report or '^^' to quit to menu"
D ^DIR S:X["^^" DIROUT=1
Q
NOPAT(LOC) ; Handles unpopulated Hospital location
N %,%H,%I,%T,%Y,GMTS,GMTSDTM,GMTSTN,GMTSHDR,GMTSPG,GMTSTITL,GMTSDTM,GMTSLFG,X,Y
D NOW^%DTC S X=% D REGDTM4^GMTSU S GMTSDTM=X,GMTSTN=$P($G(^GMT(142,+($G(GMTSTYP)),0)),"^",1)
S DIC=142,DIC(0)="NXF",X=GMTSTN S Y=$$TYPE^GMTSULT K DIC
S GMTSTITL=$S($D(^GMT(142,+Y,"T")):^("T"),1:$P(Y,U,2)),GMTSLFG=1
W @IOF D HEADER^GMTSUP W !!,"No Patients found at ",LOC," location.",!
Q
CLINIC(LOC) ; Gets list of next-day appointments for clinic
N %,%H,%I,%T,%Y,GMI,X,X1,X2,VDT,Y,GMPNM,GMDT,GMBDT,GMEDT,GMTSRES,GMTSCDT,GMDFN,GMNAME,GMDATE,GMTSLAST
S GMTSCDT=$P(LOC,U,4),GMI=0
I 'GMTSCDT D NOW^%DTC S GMTSCDT=X
S X=+GMTSCDT D REGDT4^GMTSU S GMBDT=X
S X=+$P(LOC,U,5) D REGDT4^GMTSU S GMEDT=X
S:+$P(LOC,U,5) X1=$P(LOC,U,5),X2=1
S:+$P(LOC,U,5)'>0 X1=GMTSCDT,X2=1 D C^%DTC
S GMTSLAST=X
D GETPLIST^SDAMA202(+LOC,"1;4",,GMTSCDT,GMTSLAST,.GMTSRES)
I GMTSRES<0 D Q "-1"
. N GMTSERR
. S GMTSERR=$O(^TMP($J,"SDAMA202","GETPLIST","ERROR",0))
. I 'GMTSERR Q
. D MAIL^GMTSMAIL($G(^TMP($J,"SDAMA202","GETPLIST","ERROR",GMTSERR)),"Print/Queue HS for Patient Lists")
. K ^TMP($J,"SDAMA202","GETPLIST")
F S GMI=$O(^TMP($J,"SDAMA202","GETPLIST",GMI)) Q:GMI="" D
. N X
. S X=$G(^TMP($J,"SDAMA202","GETPLIST",GMI,1))
. Q:X>GMTSLAST
. D REGDT4^GMTSU S GMDATE=X
. S GMDFN=+$G(^TMP($J,"SDAMA202","GETPLIST",GMI,4))
. S GMNAME=$P($G(^TMP($J,"SDAMA202","GETPLIST",GMI,4)),U,2)
. S ^TMP("GMTSPL",$J,GMNAME,+GMDFN)=$S($D(^TMP("GMTSPL",$J,GMNAME,+GMDFN)):GMBDT_" TO "_GMEDT,1:GMDATE)
K ^TMP($J,"SDAMA202","GETPLIST")
Q 0
WARD(LOC) ; Gets list of patients for a ward
N DFN,GMLOC,X,Y,GMDT
S GMLOC=$P($G(^DIC(42,+$G(^SC(+LOC,42)),0)),U)
I $S('$L(GMLOC):1,'$O(^DPT("CN",GMLOC,0)):1,1:0) Q
S DFN=0 F S DFN=$O(^DPT("CN",GMLOC,DFN)) Q:+DFN'>0 D
. N X
. S X=+$G(DT) D REGDT4^GMTSU S GMDT=X
. S ^TMP("GMTSPL",$J,$P($G(^DPT(+DFN,0)),U),+DFN)=GMDT
Q
OR(LOC) ; Gets list of patients scheduled for surgery
N GMBEG,GMEND,DFN,GMI,GMJ,GMPNM,GMDT,%,%H,%I,%T,%Y,X,X1,X2,Y
S GMI=+$O(^SRS("B",+LOC,0)) I +GMI'>0 G ORX
S GMBEG=$P(LOC,U,4)-.0001,GMEND=$S(+$P(LOC,U,5)>0:$P(LOC,U,5),1:$P(LOC,U,4))
F S GMBEG=$O(^SRF("AOR",+GMI,+GMBEG)) Q:+GMBEG'>0!(+GMBEG>+GMEND) D
. S GMJ=0 F S GMJ=$O(^SRF("AOR",+GMI,+GMBEG,GMJ)) Q:+GMJ'>0 D
. . S DFN=+$G(^SRF(+GMJ,0)) Q:DFN'>0
. . S GMPNM=$P($G(^DPT(+DFN,0)),U)
. . N X
. . S X=+GMBEG D REGDT4^GMTSU S GMDT=X
. . S ^TMP("GMTSPL",$J,GMPNM,+DFN)=$S($D(^TMP("GMTSPL",$J,GMPNM,+DFN)):^(+DFN)_", "_GMDT,1:GMDT)
ORX ; Exit Surgery
Q
PAT(LOC) ; Checks for patients at selected location
N %,%H,%T,LTYPE,X1,X2,X,Y,GMY,GMBEG,GMTSDATE,GMTSCDT,GMTSRES S LTYPE=$P(LOC,U,3),GMY=0
I LTYPE="W" D
. S LOC=$P($G(^DIC(42,+$G(^SC(+LOC,42)),0)),U),GMY=$S($G(LOC)']"":0,$O(^DPT("CN",LOC,0)):1,1:0)
I $L(LOC,U)=4!($L(LOC,U)=5) D
. S GMY=0 S:+$P(LOC,U,5) X1=$P(LOC,U,5),X2=1 S:+$P(LOC,U,5)'>0 X1=$P(LOC,U,4),X2=1 D C^%DTC
. S GMTSCDT=$P(LOC,U,4)
. D GETPLIST^SDAMA202(+LOC,"1",,GMTSCDT,X,.GMTSRES) Q:GMTSRES=0
. I GMTSRES<0 D Q
. . N GMTSERR
. . S GMTSERR=$O(^TMP($J,"SDAMA202","GETPLIST","ERROR",0))
. . I 'GMTSERR Q
. . D MAIL^GMTSMAIL($G(^TMP($J,"SDAMA202","GETPLIST","ERROR",GMTSERR)),"Print/Queue HS for Patient Lists")
. . K ^TMP($J,"SDAMA202","GETPLIST")
. N GMTSI S GMTSI=0,GMTSDATE=0
. F S GMTSI=$O(^TMP($J,"SDAMA202","GETPLIST",GMTSI)) Q:'GMTSI D
. . I $G(^TMP($J,"SDAMA202","GETPLIST",GMTSI,1))<X S GMTSDATE=$G(^TMP($J,"SDAMA202","GETPLIST",GMTSI,1))
. K ^TMP($J,"SDAMA202","GETPLIST")
. I LTYPE="C",(+GMTSDATE),(+GMTSDATE'>X) S GMY=1
. I LTYPE="OR" D
. . N OLOC S GMY=0,OLOC=+$O(^SRS("B",+LOC,0))
. . I +OLOC,+$P(LOC,U,5)'>0,$O(^SRF("AOR",+OLOC,+$P(LOC,U,4),0)) S GMY=1
. . I +OLOC,+$P(LOC,U,5) S GMBEG=$P(LOC,U,4) F D Q:GMBEG>$P(LOC,U,5)!(GMY>0)
. . . S:$O(^SRF("AOR",+OLOC,+GMBEG,0)) GMY=1 Q:+GMY>0 S X1=GMBEG,X2=1 D C^%DTC S GMBEG=X
Q $G(GMY)
DRIVER ; Sets variables for GMTS1 and calls ^%ZTLOAD
N %T,C,D0,GMTS,GMTS0,GMTS1,GMTS2,GMTSDOB,GMTSDTM,GMTSLO,GMTSLOCK
N GMTSLPG,GMTSEG,GMTSEGC,GMTSTN,GMTSEGI,GMTSPNM,GMTSRB
N GMTSSN,GMTSTITL,GMTSWARD,GMTSX,GMTSPHDR,GMTSAGE,GMTSTOF,GMTSCDT
N GMW,I,SEX,VA,VADM,VAIN,VAINDT,VAROOT,X,Y
S GMTSCDT(0)=^TMP("GMTSPL",$J,GMPNM,+DFN),GMTSTN=$P($G(^GMT(142,+($G(GMTSTYP)),0)),"^",1)
S DIC=142,DIC(0)="NXF",X=GMTSTN S Y=$$TYPE^GMTSULT K DIC
S GMTSTITL=$$UP^XLFSTR($S($G(^GMT(142,+Y,"T"))]"":^("T"),1:$P(Y,U,2)))
D:$D(GMTSEG)'>9 SELTYP1^GMTS D EN^GMTS1
Q
GMTSPL ; SLC/JER,KER - Print/Queue HS for Patient Lists ; 02/27/2002 [1/27/05 8:27am]
+1 ;;2.7;Health Summary;**7,27,28,30,47,49,70**;Oct 20, 1995;Build 5
+2 ;
+3 ; External References
+4 ; DBIA 10090 ^DIC(4
+5 ; DBIA 10039 ^DIC(42
+6 ; DBIA 10035 ^DPT(
+7 ; DBIA 10035 ^DPT("CN"
+8 ; DBIA 10040 ^SC(
+9 ; DBIA 16 ^SRF(
+10 ; DBIA 641 ^SRF("AOR"
+11 ; DBIA 185 ^SRS("B"
+12 ; DBIA 10091 ^XMB(1
+13 ; DBIA 10000 C^%DTC
+14 ; DBIA 10000 NOW^%DTC
+15 ; DBIA 10026 ^DIR
+16 ; DBIA 183 DFN^PSOSD1
+17 ; DBIA 10104 $$UP^XLFSTR
+18 ; DBIA 2056 $$GET1^DIQ (file #44)
+19 ;
MAIN ; Print/Queue for Patient Lists
+1 ;
+2 ; Call with:
+3 ;
+4 ; GMTSTYP = Pointer to file 142
+5 ; GMTSSC = Pointer to file 44^Hosp Loc Name^
+6 ; Hosp Loc Type^Begin Visit/Surg Date^
+7 ; Opt end Visit/Surgery Date
+8 ; GMTSSC() = GMTSSC - Array of multiple locations
+9 ; [GMPSAP] = Optional flag set to 1 if OP Rx
+10 ; Action Profile is to print
+11 ;
+12 NEW MULTLOC,GMTSEXIT
SET GMTSEXIT=0
+13 IF $DATA(GMTSSC("ALL"))
Begin DoDot:1
+14 NEW IEN,BEG,END,COR,PRM,RAN,PAT
+15 SET PRM=$GET(GMTSSC)
SET BEG=$PIECE(PRM,"^",4)
SET END=$PIECE(PRM,"^",5)
+16 SET RAN=BEG
IF $LENGTH(END)&($LENGTH(RAN))
SET RAN=RAN_"^"_END
IF $LENGTH(END)&('$LENGTH(RAN))
SET RAN=END
+17 SET IEN=0
FOR
SET IEN=$ORDER(^SC(IEN))
IF +IEN=0
QUIT
Begin DoDot:2
+18 NEW GMTSSC,NAM
SET NAM=$$GET1^DIQ(44,(+IEN_","),.01)
IF '$LENGTH(NAM)
QUIT
+19 SET COR=$$GET1^DIQ(44,(+IEN_","),2,"I")
IF COR=""
QUIT
IF "WCOR"'[COR
QUIT
+20 SET GMTSSC=IEN_"^"_NAM_"^"_COR
+21 IF "COR"[COR&($LENGTH($GET(RAN)))
SET GMTSSC=GMTSSC_"^"_RAN
+22 SET PAT=$$PAT(GMTSSC)
IF +PAT=0
QUIT
+23 DO CTRL
End DoDot:2
IF $GET(GMTSEXIT)["^^"
QUIT
End DoDot:1
QUIT
+24 IF +$ORDER(GMTSSC(0))'>0
DO CTRL
+25 IF +$ORDER(GMTSSC(0))
Begin DoDot:1
+26 SET MULTLOC=0
FOR
SET MULTLOC=$ORDER(GMTSSC(MULTLOC))
IF +MULTLOC'>0!$DATA(DIROUT)
QUIT
Begin DoDot:2
+27 SET GMTSSC=GMTSSC(+MULTLOC)
DO CTRL
End DoDot:2
End DoDot:1
+28 QUIT
CTRL ; Controls Branching
+1 NEW DFN,GMTDFN,GMLTYPE,GMTSLTR,GMPNM,PSOPAR,PSONOPG,PSOINST,PSTYPE
KILL ^TMP("GMTSPL",$JOB)
USE IO
+2 NEW GMTSBYE
SET GMTSBYE=0
+3 SET GMLTYPE=$PIECE(GMTSSC,U,3)
IF GMLTYPE="C"
SET GMTSBYE=$$CLINIC(GMTSSC)
IF GMLTYPE="W"
DO WARD(GMTSSC)
IF GMLTYPE="OR"
DO OR(GMTSSC)
+4 IF GMTSBYE
QUIT
+5 IF $LENGTH($PIECE(GMTSSC,U,2))
IF ($EXTRACT(IOST,1)'="C")
SET GMTSLTR=$EXTRACT($PIECE(GMTSSC,U,2),1,10)
DO ^GMTSLTR
+6 IF $ORDER(^TMP("GMTSPL",$JOB,0))=""
IF $DATA(GMTSSC("ALL"))
WRITE !,"ALL"
QUIT
+7 IF $ORDER(^TMP("GMTSPL",$JOB,0))=""
DO NOPAT($PIECE(GMTSSC,U,2))
QUIT
+8 SET GMPNM=""
FOR
SET GMPNM=$ORDER(^TMP("GMTSPL",$JOB,GMPNM))
IF (GMPNM="")!($DATA(DIROUT))
QUIT
Begin DoDot:1
+9 SET GMTDFN=0
FOR
SET GMTDFN=$ORDER(^TMP("GMTSPL",$JOB,GMPNM,GMTDFN))
IF (GMTDFN'>0)!($DATA(DIROUT))
QUIT
Begin DoDot:2
+10 NEW GMDUOUT
+11 SET DFN=GMTDFN
DO DRIVER
IF $DATA(DIROUT)!+$GET(GMDUOUT)
QUIT
+12 IF +$GET(GMPSAP)
Begin DoDot:3
+13 SET (PSTYPE,PSONOPG)=1
+14 SET $PIECE(PSOPAR,U)=$SELECT($PIECE($GET(^GMT(142.99,1,0)),U,5)="Y":1,1:0)
+15 SET PSOINST=$SELECT(+$GET(PSOINST):PSOINST,1:+$PIECE($GET(^DIC(4,+$PIECE($GET(^XMB(1,1,"XUS")),U,17),99)),U))
+16 DO DFN^PSOSD1
DO PAGE
End DoDot:3
End DoDot:2
End DoDot:1
+17 KILL ^TMP("GMTSPL",$JOB)
+18 QUIT
PAGE ; Pause at BOP for interactive users
+1 NEW DIR,X,Y
+2 IF $EXTRACT(IOST)'="C"!(IOT="HFS")!((IOSL>998)&($GET(GMPAT(+$ORDER(GMPAT(""),-1)))'=$GET(DFN)))
QUIT
+3 IF IOSL>($Y+5)
FOR
WRITE !
IF IOSL<($Y+6)!($Y'<22)
QUIT
+4 SET DIR(0)="FO^1:1"
SET DIR("A")="Press RETURN to continue or '^' to exit"
+5 SET DIR("?")="Enter '^' to quit present report or '^^' to quit to menu"
+6 DO ^DIR
IF X["^^"
SET DIROUT=1
+7 QUIT
NOPAT(LOC) ; Handles unpopulated Hospital location
+1 NEW %,%H,%I,%T,%Y,GMTS,GMTSDTM,GMTSTN,GMTSHDR,GMTSPG,GMTSTITL,GMTSDTM,GMTSLFG,X,Y
+2 DO NOW^%DTC
SET X=%
DO REGDTM4^GMTSU
SET GMTSDTM=X
SET GMTSTN=$PIECE($GET(^GMT(142,+($GET(GMTSTYP)),0)),"^",1)
+3 SET DIC=142
SET DIC(0)="NXF"
SET X=GMTSTN
SET Y=$$TYPE^GMTSULT
KILL DIC
+4 SET GMTSTITL=$SELECT($DATA(^GMT(142,+Y,"T")):^("T"),1:$PIECE(Y,U,2))
SET GMTSLFG=1
+5 WRITE @IOF
DO HEADER^GMTSUP
WRITE !!,"No Patients found at ",LOC," location.",!
+6 QUIT
CLINIC(LOC) ; Gets list of next-day appointments for clinic
+1 NEW %,%H,%I,%T,%Y,GMI,X,X1,X2,VDT,Y,GMPNM,GMDT,GMBDT,GMEDT,GMTSRES,GMTSCDT,GMDFN,GMNAME,GMDATE,GMTSLAST
+2 SET GMTSCDT=$PIECE(LOC,U,4)
SET GMI=0
+3 IF 'GMTSCDT
DO NOW^%DTC
SET GMTSCDT=X
+4 SET X=+GMTSCDT
DO REGDT4^GMTSU
SET GMBDT=X
+5 SET X=+$PIECE(LOC,U,5)
DO REGDT4^GMTSU
SET GMEDT=X
+6 IF +$PIECE(LOC,U,5)
SET X1=$PIECE(LOC,U,5)
SET X2=1
+7 IF +$PIECE(LOC,U,5)'>0
SET X1=GMTSCDT
SET X2=1
DO C^%DTC
+8 SET GMTSLAST=X
+9 DO GETPLIST^SDAMA202(+LOC,"1;4",,GMTSCDT,GMTSLAST,.GMTSRES)
+10 IF GMTSRES<0
Begin DoDot:1
+11 NEW GMTSERR
+12 SET GMTSERR=$ORDER(^TMP($JOB,"SDAMA202","GETPLIST","ERROR",0))
+13 IF 'GMTSERR
QUIT
+14 DO MAIL^GMTSMAIL($GET(^TMP($JOB,"SDAMA202","GETPLIST","ERROR",GMTSERR)),"Print/Queue HS for Patient Lists")
+15 KILL ^TMP($JOB,"SDAMA202","GETPLIST")
End DoDot:1
QUIT "-1"
+16 FOR
SET GMI=$ORDER(^TMP($JOB,"SDAMA202","GETPLIST",GMI))
IF GMI=""
QUIT
Begin DoDot:1
+17 NEW X
+18 SET X=$GET(^TMP($JOB,"SDAMA202","GETPLIST",GMI,1))
+19 IF X>GMTSLAST
QUIT
+20 DO REGDT4^GMTSU
SET GMDATE=X
+21 SET GMDFN=+$GET(^TMP($JOB,"SDAMA202","GETPLIST",GMI,4))
+22 SET GMNAME=$PIECE($GET(^TMP($JOB,"SDAMA202","GETPLIST",GMI,4)),U,2)
+23 SET ^TMP("GMTSPL",$JOB,GMNAME,+GMDFN)=$SELECT($DATA(^TMP("GMTSPL",$JOB,GMNAME,+GMDFN)):GMBDT_" TO "_GMEDT,1:GMDATE)
End DoDot:1
+24 KILL ^TMP($JOB,"SDAMA202","GETPLIST")
+25 QUIT 0
WARD(LOC) ; Gets list of patients for a ward
+1 NEW DFN,GMLOC,X,Y,GMDT
+2 SET GMLOC=$PIECE($GET(^DIC(42,+$GET(^SC(+LOC,42)),0)),U)
+3 IF $SELECT('$LENGTH(GMLOC):1,'$ORDER(^DPT("CN",GMLOC,0)):1,1:0)
QUIT
+4 SET DFN=0
FOR
SET DFN=$ORDER(^DPT("CN",GMLOC,DFN))
IF +DFN'>0
QUIT
Begin DoDot:1
+5 NEW X
+6 SET X=+$GET(DT)
DO REGDT4^GMTSU
SET GMDT=X
+7 SET ^TMP("GMTSPL",$JOB,$PIECE($GET(^DPT(+DFN,0)),U),+DFN)=GMDT
End DoDot:1
+8 QUIT
OR(LOC) ; Gets list of patients scheduled for surgery
+1 NEW GMBEG,GMEND,DFN,GMI,GMJ,GMPNM,GMDT,%,%H,%I,%T,%Y,X,X1,X2,Y
+2 SET GMI=+$ORDER(^SRS("B",+LOC,0))
IF +GMI'>0
GOTO ORX
+3 SET GMBEG=$PIECE(LOC,U,4)-.0001
SET GMEND=$SELECT(+$PIECE(LOC,U,5)>0:$PIECE(LOC,U,5),1:$PIECE(LOC,U,4))
+4 FOR
SET GMBEG=$ORDER(^SRF("AOR",+GMI,+GMBEG))
IF +GMBEG'>0!(+GMBEG>+GMEND)
QUIT
Begin DoDot:1
+5 SET GMJ=0
FOR
SET GMJ=$ORDER(^SRF("AOR",+GMI,+GMBEG,GMJ))
IF +GMJ'>0
QUIT
Begin DoDot:2
+6 SET DFN=+$GET(^SRF(+GMJ,0))
IF DFN'>0
QUIT
+7 SET GMPNM=$PIECE($GET(^DPT(+DFN,0)),U)
+8 NEW X
+9 SET X=+GMBEG
DO REGDT4^GMTSU
SET GMDT=X
+10 SET ^TMP("GMTSPL",$JOB,GMPNM,+DFN)=$SELECT($DATA(^TMP("GMTSPL",$JOB,GMPNM,+DFN)):^(+DFN)_", "_GMDT,1:GMDT)
End DoDot:2
End DoDot:1
ORX ; Exit Surgery
+1 QUIT
PAT(LOC) ; Checks for patients at selected location
+1 NEW %,%H,%T,LTYPE,X1,X2,X,Y,GMY,GMBEG,GMTSDATE,GMTSCDT,GMTSRES
SET LTYPE=$PIECE(LOC,U,3)
SET GMY=0
+2 IF LTYPE="W"
Begin DoDot:1
+3 SET LOC=$PIECE($GET(^DIC(42,+$GET(^SC(+LOC,42)),0)),U)
SET GMY=$SELECT($GET(LOC)']"":0,$ORDER(^DPT("CN",LOC,0)):1,1:0)
End DoDot:1
+4 IF $LENGTH(LOC,U)=4!($LENGTH(LOC,U)=5)
Begin DoDot:1
+5 SET GMY=0
IF +$PIECE(LOC,U,5)
SET X1=$PIECE(LOC,U,5)
SET X2=1
IF +$PIECE(LOC,U,5)'>0
SET X1=$PIECE(LOC,U,4)
SET X2=1
DO C^%DTC
+6 SET GMTSCDT=$PIECE(LOC,U,4)
+7 DO GETPLIST^SDAMA202(+LOC,"1",,GMTSCDT,X,.GMTSRES)
IF GMTSRES=0
QUIT
+8 IF GMTSRES<0
Begin DoDot:2
+9 NEW GMTSERR
+10 SET GMTSERR=$ORDER(^TMP($JOB,"SDAMA202","GETPLIST","ERROR",0))
+11 IF 'GMTSERR
QUIT
+12 DO MAIL^GMTSMAIL($GET(^TMP($JOB,"SDAMA202","GETPLIST","ERROR",GMTSERR)),"Print/Queue HS for Patient Lists")
+13 KILL ^TMP($JOB,"SDAMA202","GETPLIST")
End DoDot:2
QUIT
+14 NEW GMTSI
SET GMTSI=0
SET GMTSDATE=0
+15 FOR
SET GMTSI=$ORDER(^TMP($JOB,"SDAMA202","GETPLIST",GMTSI))
IF 'GMTSI
QUIT
Begin DoDot:2
+16 IF $GET(^TMP($JOB,"SDAMA202","GETPLIST",GMTSI,1))<X
SET GMTSDATE=$GET(^TMP($JOB,"SDAMA202","GETPLIST",GMTSI,1))
End DoDot:2
+17 KILL ^TMP($JOB,"SDAMA202","GETPLIST")
+18 IF LTYPE="C"
IF (+GMTSDATE)
IF (+GMTSDATE'>X)
SET GMY=1
+19 IF LTYPE="OR"
Begin DoDot:2
+20 NEW OLOC
SET GMY=0
SET OLOC=+$ORDER(^SRS("B",+LOC,0))
+21 IF +OLOC
IF +$PIECE(LOC,U,5)'>0
IF $ORDER(^SRF("AOR",+OLOC,+$PIECE(LOC,U,4),0))
SET GMY=1
+22 IF +OLOC
IF +$PIECE(LOC,U,5)
SET GMBEG=$PIECE(LOC,U,4)
FOR
Begin DoDot:3
+23 IF $ORDER(^SRF("AOR",+OLOC,+GMBEG,0))
SET GMY=1
IF +GMY>0
QUIT
SET X1=GMBEG
SET X2=1
DO C^%DTC
SET GMBEG=X
End DoDot:3
IF GMBEG>$PIECE(LOC,U,5)!(GMY>0)
QUIT
End DoDot:2
End DoDot:1
+24 QUIT $GET(GMY)
DRIVER ; Sets variables for GMTS1 and calls ^%ZTLOAD
+1 NEW %T,C,D0,GMTS,GMTS0,GMTS1,GMTS2,GMTSDOB,GMTSDTM,GMTSLO,GMTSLOCK
+2 NEW GMTSLPG,GMTSEG,GMTSEGC,GMTSTN,GMTSEGI,GMTSPNM,GMTSRB
+3 NEW GMTSSN,GMTSTITL,GMTSWARD,GMTSX,GMTSPHDR,GMTSAGE,GMTSTOF,GMTSCDT
+4 NEW GMW,I,SEX,VA,VADM,VAIN,VAINDT,VAROOT,X,Y
+5 SET GMTSCDT(0)=^TMP("GMTSPL",$JOB,GMPNM,+DFN)
SET GMTSTN=$PIECE($GET(^GMT(142,+($GET(GMTSTYP)),0)),"^",1)
+6 SET DIC=142
SET DIC(0)="NXF"
SET X=GMTSTN
SET Y=$$TYPE^GMTSULT
KILL DIC
+7 SET GMTSTITL=$$UP^XLFSTR($SELECT($GET(^GMT(142,+Y,"T"))]"":^("T"),1:$PIECE(Y,U,2)))
+8 IF $DATA(GMTSEG)'>9
DO SELTYP1^GMTS
DO EN^GMTS1
+9 QUIT
