- 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,88**;Oct 20, 1995;Build 23
- ;
- ; 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))
- ; RJT/VM GMTS*2.7*88
- I ($E(IOST,1)'="C"),$$GET1^DIQ(142.99,1,.07,"^TMP(""GMTS"",$J,""SHORT HS BY LOC"")")="Yes" W @IOF
- 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
- ; RJT/VM GMTS*2.7*88
- D
- . I $$GET1^DIQ(142.99,1,.07,"^TMP(""GMTS"",$J,""SHORT HS BY LOC"")")="Yes" W !!!! D HEADER^GMTSUP W !!,"No Patients found at ",LOC," location.",! Q
- . 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSPL 7976 printed Jan 18, 2025@03:00:28 Page 2
- 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,88**;Oct 20, 1995;Build 23
- +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))
- +8 ; RJT/VM GMTS*2.7*88
- +9 IF ($EXTRACT(IOST,1)'="C")
- IF $$GET1^DIQ(142.99,1,.07,"^TMP(""GMTS"",$J,""SHORT HS BY LOC"")")="Yes"
- WRITE @IOF
- +10 SET GMPNM=""
- FOR
- SET GMPNM=$ORDER(^TMP("GMTSPL",$JOB,GMPNM))
- if (GMPNM="")!($DATA(DIROUT))
- QUIT
- Begin DoDot:1
- +11 SET GMTDFN=0
- FOR
- SET GMTDFN=$ORDER(^TMP("GMTSPL",$JOB,GMPNM,GMTDFN))
- if (GMTDFN'>0)!($DATA(DIROUT))
- QUIT
- Begin DoDot:2
- +12 NEW GMDUOUT
- +13 SET DFN=GMTDFN
- DO DRIVER
- if $DATA(DIROUT)!+$GET(GMDUOUT)
- QUIT
- +14 IF +$GET(GMPSAP)
- Begin DoDot:3
- +15 SET (PSTYPE,PSONOPG)=1
- +16 SET $PIECE(PSOPAR,U)=$SELECT($PIECE($GET(^GMT(142.99,1,0)),U,5)="Y":1,1:0)
- +17 SET PSOINST=$SELECT(+$GET(PSOINST):PSOINST,1:+$PIECE($GET(^DIC(4,+$PIECE($GET(^XMB(1,1,"XUS")),U,17),99)),U))
- +18 DO DFN^PSOSD1
- DO PAGE
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +19 KILL ^TMP("GMTSPL",$JOB)
- +20 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 ; RJT/VM GMTS*2.7*88
- +6 Begin DoDot:1
- +7 IF $$GET1^DIQ(142.99,1,.07,"^TMP(""GMTS"",$J,""SHORT HS BY LOC"")")="Yes"
- WRITE !!!!
- DO HEADER^GMTSUP
- WRITE !!,"No Patients found at ",LOC," location.",!
- QUIT
- +8 WRITE @IOF
- DO HEADER^GMTSUP
- WRITE !!,"No Patients found at ",LOC," location.",!
- End DoDot:1
- +9 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