- GMTSPD ; SLC/JER,KER - Interactive Print-by-Location ; 04/30/2002 [1/26/05 1:50pm]
- ;;2.7;Health Summary;**28,30,47,49,55,70**;Oct 20, 1995;Build 5
- ;
- ; External
- ; DBIA 10040 ^SC(
- ; DBIA 10040 ^SC("B"
- ; DBIA 641 ^SRF("AOR"
- ; DBIA 185 ^SRS("B"
- ; DBIA 10039 ^DIC(42
- ; DBIA 510 ^DISV(
- ; DBIA 10035 ^DPT("CN"
- ; DBIA 10000 C^%DTC
- ; DBIA 10000 NOW^%DTC
- ; DBIA 10006 ^DIC (file #42 and #44)
- ; DBIA 10026 ^DIR
- ; DBIA 10076 ^XUSEC("GMTS VIEW ONLY"
- ; DBIA 10104 $$UP^XLFSTR
- ;
- MAIN ; Interactive Print by Location
- N GMPSAP,GMTSCDT,GMTSTYP,GMLOC,GMTSTN,GMTSSC
- S GMTSTYP=0 K DIROUT
- F D Q:+GMTSTYP'>0!$D(DIROUT)
- . S GMTSTYP=+($$SELTYP) Q:+GMTSTYP'>0!$D(DIROUT)
- . F D Q:+$G(GMTSSC)'>0!$D(DIROUT)!$D(DUOUT)!($D(GMTSSC("ALL")))
- . . K GMTSSC,DUOUT D SELLOC(.GMTSSC) Q:+$G(GMTSSC)'>0!$D(DIROUT)!$D(DUOUT)
- . . D CHKLOC(.GMTSSC) Q:$O(GMTSSC(0))'>0!$D(DIROUT)!$D(DTOUT)!$D(DUOUT)
- . . S GMPSAP=$$RXAP^GMTSPD2 Q:$D(DIROUT)!$D(DUOUT)!$D(DTOUT)
- . . N DIROUT D HSOUT^GMTSPD2 W ! S DUOUT=1
- Q
- SELTYP() ; Select Health Summary type
- N DIC,X,Y
- I $D(^DISV(DUZ,"^GMT(142,")),+$G(GMTSTYP)=0 S DIC("B")=$P($G(^GMT(142,+$G(^DISV(DUZ,"^GMT(142,")),0)),U)
- S DIC=142,DIC("A")="Select Health Summary Type: "
- S DIC(0)="AEQM",DIC("S")="I $P(^(0),U)'=""GMTS HS ADHOC OPTION"""
- S Y=$$TYPE^GMTSULT I +Y'>0,X="^^" S DIROUT=1
- I +Y>0,$S($D(^GMT(142,+Y,1,0))=0:1,$O(^(0))'>0:1,1:0) D
- . W !,"This Summary Type includes no components...Please choose another."
- Q Y
- SELLOC(GMX) ; Select multiple Hospital Location
- N DIC,LOC,Y,X,DIR,GMTSLC
- S DIC=44,DIC(0)="AEMQZ",DIC("A")="Select Hospital Location: ",GMTSLC=0
- I $D(^XUSEC("GMTS VIEW ONLY",+($G(DUZ)))) S GMTSLC=1
- S DIC("S")="I ""WCOR""[$P(^(0),U,3)"
- F D Q:+$G(GMX(+$G(Y)))'>0!$D(DIROUT)!$D(DTOUT)!$D(DUOUT) Q:GMTSLC<0
- . D:GMTSLC'>0 ASK Q:$D(GMX("ALL"))
- . D:GMTSLC>0 ^DIC S GMTSLC=GMTSLC+1 Q:$G(DIROUT)=1
- . I +Y'>0 S:X="^^" DIROUT=1 Q
- . S GMX(+Y)=$P(Y,U,1,2)_U_$P(Y(0),U,3)
- . S $P(GMX,U)=+Y
- . I "COR"[$P(Y(0),U,3) S $P(GMX,U,3)="COR"
- . S DIC("A")="Select Next Hospital Location: "
- Q
- ASK ; Prompt for One or ALL
- N ERR,DIC,DIR,LASTI,LAST
- ASK2 S DIR("A")="Select Hospital Location: "
- S LASTI=$G(^DISV(+($G(DUZ)),"^SC(")),LAST=$S(+LASTI>0:$P($G(^SC(+LASTI,0)),"^",1),1:"")
- S DIR(0)="FAO^1:30",DIR("?")="^D A1^GMTSPD",DIR("??")="^D A2^GMTSPD"
- D ^DIR I $L($G(X)),$E($G(X),1)=" ",$L(LAST),+($G(LASTI))>0 D Q
- . W " ",LAST S X=LAST,Y=+LASTI_"^"_LAST,Y(0)=$G(^SC(+LASTI,0)),Y(0,0)=LAST Q
- I $$UP^XLFSTR(Y)="ALL" D Q
- . K GMX S GMX="1^ALL^COR",GMX("ALL")="",GMX(1)="1^ALL^C",GMTSLC=-1
- S ERR=1,DIC=44,DIC(0)="EMZ"
- S DIC("S")="I ""WCOR""[$P(^(0),U,3) S ERR=0"
- D ^DIC
- I $L(X),+($G(ERR))>0 D W ! G ASK2
- . W " ??",!!,?5,"Not a ward, clinic or operating room"
- I +Y'>0 S:X["^^" DIROUT=1,GMTSEXIT="^^" Q
- Q
- A1 ; Single ? Help
- W !," Answer with HOSPITAL LOCATION NAME, or ABBREVIATION, TEAM or 'ALL'"
- W !," for all hospital locations. Enter '^' to return to Health Summary"
- W !," Type Selection or '^^' to exit."
- Q
- A2 ; Double ?? Help
- N GMTSN,GMTSI,GMTSL,GMTSC,GMTSE,GMTSP,GMTSA S GMTSP=+($G(IOSL))-9 S:GMTSP'>0 GMTSP=15
- S (GMTSA,GMTSC,GMTSE)=0,GMTSN="" D A1 W !
- F S GMTSN=$O(^SC("B",GMTSN)) Q:GMTSN="" D Q:GMTSE
- . S GMTSI=0 F S GMTSI=$O(^SC("B",GMTSN,GMTSI)) Q:GMTSI="" D Q:GMTSE
- . . S GMTSL=$P($G(^SC(GMTSI,0)),"^",1) Q:'$L(GMTSL) S GMTSC=GMTSC+1,GMTSA=GMTSA+1
- . . W:GMTSC=1 !,?3,"Choose from:" W !,?3,GMTSL
- . . I GMTSA'<GMTSP D CONT
- Q
- CONT ; Continue Displaying List
- S GMTSP=+($G(IOSL))-1 S:GMTSP'>0 GMTSP=23 S GMTSA=0
- N DIR,DA,X,Y,DTOUT,DUOUT,DIRUT,DIROUT S DIR(0)="E",DIR("A")=" '^' TO STOP",(DIR("?"),DIR("??"))="^D C1^GMTSPD"
- D ^DIR S:+($G(Y))=0 GMTSE=1
- Q
- C1 ; Continue Help
- W !," Enter ether RETURN or '^'" Q
- CHKLOC(LOC) ; Get date range for Clinics/ORs
- I $P($G(LOC),U,3)="COR" D Q:$D(DIROUT)!$D(DTOUT)!$D(DUOUT)
- . S $P(LOC,U,4)=$$SELDATE
- W ! S GMLOC=0 F S GMLOC=$O(LOC(GMLOC)) Q:+GMLOC'>0 D
- . I "COR"[$P(LOC(+GMLOC),U,3) S $P(LOC(+GMLOC),U,4)=$P(LOC,U,4,5)
- Q
- SELDATE() ; Visit/Surgery date range for Print-by-Clinic
- N %,%H,%I,DIR,DEFDT,X,Y,GMBEG,GMEND
- S (GMBEG,GMEND)=0
- D NOW^%DTC S (X,DT)=$P(%,".") D REGDT4^GMTSU S DEFDT=X
- S DIR(0)="D^::EX",DIR("B")=DEFDT
- S DIR("A")="Please enter the beginning Visit or Surgery date"
- D ^DIR
- I Y="^^" S DIROUT=1
- S GMBEG=Y
- I +GMBEG>0 D
- . S X=$P(GMBEG,".") D REGDT4^GMTSU S DEFDT=X
- . S DIR(0)="DO^::EX",DIR("B")=DEFDT
- . S DIR("A")="Please enter the ending Visit or Surgery date"
- . D ^DIR
- . I Y="^^" S DIROUT=1
- . S GMEND=Y
- Q $S(+GMEND>0&(GMEND>GMBEG):GMBEG_U_GMEND,+GMEND>0&(GMEND<GMBEG):GMEND_U_GMBEG,+GMEND>0&(GMEND=GMBEG):GMBEG,1:0)
- CKPAT(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)
- I LTYPE="W" D
- . S LOC=$P($G(^DIC(42,+$G(^SC(+LOC,42)),0)),U)
- . S 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
- . I +$P(LOC,U,5) S X1=$P(LOC,U,5),X2=1 D C^%DTC
- . I +$P(LOC,U,5)'>0 S 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
- . . S GMY=-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)),"Nightly Job to Queue HS Batch Print-by-Loc")
- . . 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) D
- . . . S GMBEG=$P(LOC,U,4)
- . . . F D Q:GMBEG>$P(LOC,U,5)!(GMY>0)
- . . . . I $O(^SRF("AOR",+OLOC,+GMBEG,0)) S GMY=1
- . . . . E S X1=GMBEG,X2=1 D C^%DTC S GMBEG=X
- Q $G(GMY)
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSPD 6212 printed Feb 18, 2025@23:25:30 Page 2
- GMTSPD ; SLC/JER,KER - Interactive Print-by-Location ; 04/30/2002 [1/26/05 1:50pm]
- +1 ;;2.7;Health Summary;**28,30,47,49,55,70**;Oct 20, 1995;Build 5
- +2 ;
- +3 ; External
- +4 ; DBIA 10040 ^SC(
- +5 ; DBIA 10040 ^SC("B"
- +6 ; DBIA 641 ^SRF("AOR"
- +7 ; DBIA 185 ^SRS("B"
- +8 ; DBIA 10039 ^DIC(42
- +9 ; DBIA 510 ^DISV(
- +10 ; DBIA 10035 ^DPT("CN"
- +11 ; DBIA 10000 C^%DTC
- +12 ; DBIA 10000 NOW^%DTC
- +13 ; DBIA 10006 ^DIC (file #42 and #44)
- +14 ; DBIA 10026 ^DIR
- +15 ; DBIA 10076 ^XUSEC("GMTS VIEW ONLY"
- +16 ; DBIA 10104 $$UP^XLFSTR
- +17 ;
- MAIN ; Interactive Print by Location
- +1 NEW GMPSAP,GMTSCDT,GMTSTYP,GMLOC,GMTSTN,GMTSSC
- +2 SET GMTSTYP=0
- KILL DIROUT
- +3 FOR
- Begin DoDot:1
- +4 SET GMTSTYP=+($$SELTYP)
- if +GMTSTYP'>0!$DATA(DIROUT)
- QUIT
- +5 FOR
- Begin DoDot:2
- +6 KILL GMTSSC,DUOUT
- DO SELLOC(.GMTSSC)
- if +$GET(GMTSSC)'>0!$DATA(DIROUT)!$DATA(DUOUT)
- QUIT
- +7 DO CHKLOC(.GMTSSC)
- if $ORDER(GMTSSC(0))'>0!$DATA(DIROUT)!$DATA(DTOUT)!$DATA(DUOUT)
- QUIT
- +8 SET GMPSAP=$$RXAP^GMTSPD2
- if $DATA(DIROUT)!$DATA(DUOUT)!$DATA(DTOUT)
- QUIT
- +9 NEW DIROUT
- DO HSOUT^GMTSPD2
- WRITE !
- SET DUOUT=1
- End DoDot:2
- if +$GET(GMTSSC)'>0!$DATA(DIROUT)!$DATA(DUOUT)!($DATA(GMTSSC("ALL")))
- QUIT
- End DoDot:1
- if +GMTSTYP'>0!$DATA(DIROUT)
- QUIT
- +10 QUIT
- SELTYP() ; Select Health Summary type
- +1 NEW DIC,X,Y
- +2 IF $DATA(^DISV(DUZ,"^GMT(142,"))
- IF +$GET(GMTSTYP)=0
- SET DIC("B")=$PIECE($GET(^GMT(142,+$GET(^DISV(DUZ,"^GMT(142,")),0)),U)
- +3 SET DIC=142
- SET DIC("A")="Select Health Summary Type: "
- +4 SET DIC(0)="AEQM"
- SET DIC("S")="I $P(^(0),U)'=""GMTS HS ADHOC OPTION"""
- +5 SET Y=$$TYPE^GMTSULT
- IF +Y'>0
- IF X="^^"
- SET DIROUT=1
- +6 IF +Y>0
- IF $SELECT($DATA(^GMT(142,+Y,1,0))=0:1,$ORDER(^(0))'>0:1,1:0)
- Begin DoDot:1
- +7 WRITE !,"This Summary Type includes no components...Please choose another."
- End DoDot:1
- +8 QUIT Y
- SELLOC(GMX) ; Select multiple Hospital Location
- +1 NEW DIC,LOC,Y,X,DIR,GMTSLC
- +2 SET DIC=44
- SET DIC(0)="AEMQZ"
- SET DIC("A")="Select Hospital Location: "
- SET GMTSLC=0
- +3 IF $DATA(^XUSEC("GMTS VIEW ONLY",+($GET(DUZ))))
- SET GMTSLC=1
- +4 SET DIC("S")="I ""WCOR""[$P(^(0),U,3)"
- +5 FOR
- Begin DoDot:1
- +6 if GMTSLC'>0
- DO ASK
- if $DATA(GMX("ALL"))
- QUIT
- +7 if GMTSLC>0
- DO ^DIC
- SET GMTSLC=GMTSLC+1
- if $GET(DIROUT)=1
- QUIT
- +8 IF +Y'>0
- if X="^^"
- SET DIROUT=1
- QUIT
- +9 SET GMX(+Y)=$PIECE(Y,U,1,2)_U_$PIECE(Y(0),U,3)
- +10 SET $PIECE(GMX,U)=+Y
- +11 IF "COR"[$PIECE(Y(0),U,3)
- SET $PIECE(GMX,U,3)="COR"
- +12 SET DIC("A")="Select Next Hospital Location: "
- End DoDot:1
- if +$GET(GMX(+$GET(Y)))'>0!$DATA(DIROUT)!$DATA(DTOUT)!$DATA(DUOUT)
- QUIT
- if GMTSLC<0
- QUIT
- +13 QUIT
- ASK ; Prompt for One or ALL
- +1 NEW ERR,DIC,DIR,LASTI,LAST
- ASK2 SET DIR("A")="Select Hospital Location: "
- +1 SET LASTI=$GET(^DISV(+($GET(DUZ)),"^SC("))
- SET LAST=$SELECT(+LASTI>0:$PIECE($GET(^SC(+LASTI,0)),"^",1),1:"")
- +2 SET DIR(0)="FAO^1:30"
- SET DIR("?")="^D A1^GMTSPD"
- SET DIR("??")="^D A2^GMTSPD"
- +3 DO ^DIR
- IF $LENGTH($GET(X))
- IF $EXTRACT($GET(X),1)=" "
- IF $LENGTH(LAST)
- IF +($GET(LASTI))>0
- Begin DoDot:1
- +4 WRITE " ",LAST
- SET X=LAST
- SET Y=+LASTI_"^"_LAST
- SET Y(0)=$GET(^SC(+LASTI,0))
- SET Y(0,0)=LAST
- QUIT
- End DoDot:1
- QUIT
- +5 IF $$UP^XLFSTR(Y)="ALL"
- Begin DoDot:1
- +6 KILL GMX
- SET GMX="1^ALL^COR"
- SET GMX("ALL")=""
- SET GMX(1)="1^ALL^C"
- SET GMTSLC=-1
- End DoDot:1
- QUIT
- +7 SET ERR=1
- SET DIC=44
- SET DIC(0)="EMZ"
- +8 SET DIC("S")="I ""WCOR""[$P(^(0),U,3) S ERR=0"
- +9 DO ^DIC
- +10 IF $LENGTH(X)
- IF +($GET(ERR))>0
- Begin DoDot:1
- +11 WRITE " ??",!!,?5,"Not a ward, clinic or operating room"
- End DoDot:1
- WRITE !
- GOTO ASK2
- +12 IF +Y'>0
- if X["^^"
- SET DIROUT=1
- SET GMTSEXIT="^^"
- QUIT
- +13 QUIT
- A1 ; Single ? Help
- +1 WRITE !," Answer with HOSPITAL LOCATION NAME, or ABBREVIATION, TEAM or 'ALL'"
- +2 WRITE !," for all hospital locations. Enter '^' to return to Health Summary"
- +3 WRITE !," Type Selection or '^^' to exit."
- +4 QUIT
- A2 ; Double ?? Help
- +1 NEW GMTSN,GMTSI,GMTSL,GMTSC,GMTSE,GMTSP,GMTSA
- SET GMTSP=+($GET(IOSL))-9
- if GMTSP'>0
- SET GMTSP=15
- +2 SET (GMTSA,GMTSC,GMTSE)=0
- SET GMTSN=""
- DO A1
- WRITE !
- +3 FOR
- SET GMTSN=$ORDER(^SC("B",GMTSN))
- if GMTSN=""
- QUIT
- Begin DoDot:1
- +4 SET GMTSI=0
- FOR
- SET GMTSI=$ORDER(^SC("B",GMTSN,GMTSI))
- if GMTSI=""
- QUIT
- Begin DoDot:2
- +5 SET GMTSL=$PIECE($GET(^SC(GMTSI,0)),"^",1)
- if '$LENGTH(GMTSL)
- QUIT
- SET GMTSC=GMTSC+1
- SET GMTSA=GMTSA+1
- +6 if GMTSC=1
- WRITE !,?3,"Choose from:"
- WRITE !,?3,GMTSL
- +7 IF GMTSA'<GMTSP
- DO CONT
- End DoDot:2
- if GMTSE
- QUIT
- End DoDot:1
- if GMTSE
- QUIT
- +8 QUIT
- CONT ; Continue Displaying List
- +1 SET GMTSP=+($GET(IOSL))-1
- if GMTSP'>0
- SET GMTSP=23
- SET GMTSA=0
- +2 NEW DIR,DA,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
- SET DIR(0)="E"
- SET DIR("A")=" '^' TO STOP"
- SET (DIR("?"),DIR("??"))="^D C1^GMTSPD"
- +3 DO ^DIR
- if +($GET(Y))=0
- SET GMTSE=1
- +4 QUIT
- C1 ; Continue Help
- +1 WRITE !," Enter ether RETURN or '^'"
- QUIT
- CHKLOC(LOC) ; Get date range for Clinics/ORs
- +1 IF $PIECE($GET(LOC),U,3)="COR"
- Begin DoDot:1
- +2 SET $PIECE(LOC,U,4)=$$SELDATE
- End DoDot:1
- if $DATA(DIROUT)!$DATA(DTOUT)!$DATA(DUOUT)
- QUIT
- +3 WRITE !
- SET GMLOC=0
- FOR
- SET GMLOC=$ORDER(LOC(GMLOC))
- if +GMLOC'>0
- QUIT
- Begin DoDot:1
- +4 IF "COR"[$PIECE(LOC(+GMLOC),U,3)
- SET $PIECE(LOC(+GMLOC),U,4)=$PIECE(LOC,U,4,5)
- End DoDot:1
- +5 QUIT
- SELDATE() ; Visit/Surgery date range for Print-by-Clinic
- +1 NEW %,%H,%I,DIR,DEFDT,X,Y,GMBEG,GMEND
- +2 SET (GMBEG,GMEND)=0
- +3 DO NOW^%DTC
- SET (X,DT)=$PIECE(%,".")
- DO REGDT4^GMTSU
- SET DEFDT=X
- +4 SET DIR(0)="D^::EX"
- SET DIR("B")=DEFDT
- +5 SET DIR("A")="Please enter the beginning Visit or Surgery date"
- +6 DO ^DIR
- +7 IF Y="^^"
- SET DIROUT=1
- +8 SET GMBEG=Y
- +9 IF +GMBEG>0
- Begin DoDot:1
- +10 SET X=$PIECE(GMBEG,".")
- DO REGDT4^GMTSU
- SET DEFDT=X
- +11 SET DIR(0)="DO^::EX"
- SET DIR("B")=DEFDT
- +12 SET DIR("A")="Please enter the ending Visit or Surgery date"
- +13 DO ^DIR
- +14 IF Y="^^"
- SET DIROUT=1
- +15 SET GMEND=Y
- End DoDot:1
- +16 QUIT $SELECT(+GMEND>0&(GMEND>GMBEG):GMBEG_U_GMEND,+GMEND>0&(GMEND<GMBEG):GMEND_U_GMBEG,+GMEND>0&(GMEND=GMBEG):GMBEG,1:0)
- CKPAT(LOC) ; Checks for patients at selected location
- +1 NEW %,%H,%T,LTYPE,X1,X2,X,Y,GMY,GMBEG,GMTSDATE,GMTSCDT,GMTSRES
- +2 SET LTYPE=$PIECE(LOC,U,3)
- +3 IF LTYPE="W"
- Begin DoDot:1
- +4 SET LOC=$PIECE($GET(^DIC(42,+$GET(^SC(+LOC,42)),0)),U)
- +5 SET GMY=$SELECT($GET(LOC)']"":0,$ORDER(^DPT("CN",LOC,0)):1,1:0)
- End DoDot:1
- +6 IF $LENGTH(LOC,U)=4!($LENGTH(LOC,U)=5)
- Begin DoDot:1
- +7 SET GMY=0
- +8 IF +$PIECE(LOC,U,5)
- SET X1=$PIECE(LOC,U,5)
- SET X2=1
- DO C^%DTC
- +9 IF +$PIECE(LOC,U,5)'>0
- SET X1=$PIECE(LOC,U,4)
- SET X2=1
- DO C^%DTC
- +10 SET GMTSCDT=$PIECE(LOC,U,4)
- +11 DO GETPLIST^SDAMA202(+LOC,"1",,GMTSCDT,X,.GMTSRES)
- if GMTSRES=0
- QUIT
- +12 IF GMTSRES<0
- Begin DoDot:2
- +13 SET GMY=-1
- +14 NEW GMTSERR
- +15 SET GMTSERR=$ORDER(^TMP($JOB,"SDAMA202","GETPLIST","ERROR",0))
- +16 IF 'GMTSERR
- QUIT
- +17 DO MAIL^GMTSMAIL($GET(^TMP($JOB,"SDAMA202","GETPLIST","ERROR",GMTSERR)),"Nightly Job to Queue HS Batch Print-by-Loc")
- +18 KILL ^TMP($JOB,"SDAMA202","GETPLIST")
- End DoDot:2
- QUIT
- +19 NEW GMTSI
- SET GMTSI=0
- SET GMTSDATE=0
- +20 FOR
- SET GMTSI=$ORDER(^TMP($JOB,"SDAMA202","GETPLIST",GMTSI))
- if 'GMTSI
- QUIT
- Begin DoDot:2
- +21 IF $GET(^TMP($JOB,"SDAMA202","GETPLIST",GMTSI,1))<X
- SET GMTSDATE=$GET(^TMP($JOB,"SDAMA202","GETPLIST",GMTSI,1))
- End DoDot:2
- +22 KILL ^TMP($JOB,"SDAMA202","GETPLIST")
- +23 IF LTYPE="C"
- IF (+GMTSDATE)
- IF (+GMTSDATE'>X)
- SET GMY=1
- +24 IF LTYPE="OR"
- Begin DoDot:2
- +25 NEW OLOC
- SET GMY=0
- SET OLOC=+$ORDER(^SRS("B",+LOC,0))
- +26 IF +OLOC
- IF +$PIECE(LOC,U,5)'>0
- IF $ORDER(^SRF("AOR",+OLOC,+$PIECE(LOC,U,4),0))
- SET GMY=1
- +27 IF +OLOC
- IF +$PIECE(LOC,U,5)
- Begin DoDot:3
- +28 SET GMBEG=$PIECE(LOC,U,4)
- +29 FOR
- Begin DoDot:4
- +30 IF $ORDER(^SRF("AOR",+OLOC,+GMBEG,0))
- SET GMY=1
- +31 IF '$TEST
- SET X1=GMBEG
- SET X2=1
- DO C^%DTC
- SET GMBEG=X
- End DoDot:4
- if GMBEG>$PIECE(LOC,U,5)!(GMY>0)
- QUIT
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +32 QUIT $GET(GMY)