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 Oct 16, 2024@17:59:55 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)
