GMRCPSL2 ;SLC/MA - Special Consult Reports;9/21/01 05:25 ;1/17/02 18:19
;;3.0;CONSULT/REQUEST TRACKING;**23,22**;DEC 27, 1997
; This routine is used by GMRCPSL1 to build ^TMP("GMRCRPT",$J)
; which will be passed to GMRCPSL3.
PRINT(GMRCSRCH,GMRCARRY,GMRCDT1,GMRCDT2,GMRCSTAT,GMRCRPT,GMRCBRK) ; Untasked Print
PRTTSK ; Print report
; GMRCARRY = Array contains search values.
; GMRCSRCH = Indicates which field to search on
; GMRCDT1 = Start date
; GMRCDT2 = Stop date
; GMRCSTAT = CPRS status to include in report
; SUBTOT = Counter for different groups
; GMRCRPT = 80 - 132 character report & data only output
; GMRCBRK = Print page break between sub-totals <Y-N>
; TOTCNTR = Count for total records
I GMRCSRCH=1 D BLDPROV(.GMRCARRY) ;BLD PROVIDER ^TMP(GLOBAL)
I GMRCSRCH=2 D BLDLOC(.GMRCARRY) ;BLD LOCATION ^TMP(GLOBAL)
I GMRCSRCH=3 D BLDPROC(.GMRCARRY) ;BLD PROCEDURE ^TMP(GLOBAL)
N TOTCNTR,SUBTOT S (SUBTOT,TOTCNTR)=0
I GMRCRPT=1 D REPORT80^GMRCPSL3(.SUBTOT,.TOTCNTR,GMRCSRCH,GMRCBRK)
I GMRCRPT=2 D REPORT32^GMRCPSL3(.SUBTOT,.TOTCNTR,GMRCSRCH,GMRCBRK)
I GMRCRPT=3 D DATAONLY^GMRCPSL4 Q
W !!,"SUB TOTAL= ",SUBTOT,!
W !,"TOTAL RECORDS= ",TOTCNTR
D ^%ZISC
K ^TMP("GMRCRPT",$J)
I ($E(IOST)="C") D
.N DIR
.S DIR(0)="E"
.W !
.D ^DIR K DIR
Q
;
BLDLOC(GMRCARRY) ; Build ^TMP were search was on location.
K ^TMP("GMRCRPT",$J)
N GMRCCNTR,LOCATION,GMRCSRT1,GMRCSRT2,GMRCLOC1,GMRCLOC2,IEN
N GMRCREM,LOCPN
S GMRCCNTR=0
;
; get all Locations by date range
I GMRCARRY(1)="ALL" D
. S GMRCLOC1=GMRCDT1,GMRCLOC2=GMRCDT2
. F S GMRCLOC1=$O(^GMR(123,"E",GMRCLOC1)) Q:GMRCLOC1>GMRCLOC2 Q:GMRCLOC1="" D
. . S IEN=0
. . F S IEN=$O(^GMR(123,"E",GMRCLOC1,IEN)) Q:IEN'>0 D
. . . ;
. . . ; Check for Patient Location
. . . I "LB"[GMRCARRY,$$CKSTAT(IEN,GMRCSTAT),+$P(^GMR(123,IEN,0),"^",4) D Q
. . . . S LOCATION=$P(^GMR(123,IEN,0),"^",4) ; PATIENT LOCATION
. . . . S GMRCSRT1=$$GET1^DIQ(44,LOCATION,.01) ; PATIENT LOCATION
. . . . S GMRCSRT2=$P(^GMR(123,IEN,0),"^",7) ; DATE OF REQUEST
. . . . S ^TMP("GMRCRPT",$J,GMRCSRT1,GMRCSRT2,IEN)=IEN_"|"_^GMR(123,IEN,0)
. . . ;
. . . ; If no patient location, check for Ordering Facility
. . . I $$CKSTAT(IEN,GMRCSTAT),'+$P(^GMR(123,IEN,0),"^",4),+$P(^GMR(123,IEN,0),"^",21),("L"[GMRCARRY&'+$P(^GMR(123,IEN,0),"^",23)!("RB"[GMRCARRY&+$P(^GMR(123,IEN,0),"^",23))) D Q
. . . . S LOCATION=$P(^GMR(123,IEN,0),"^",21) ;ORDERING FACILITY
. . . . S GMRCSRT1=$$GET1^DIQ(4,LOCATION,.01) ;ORDERING FACILITY
. . . . S GMRCSRT2=$P(^GMR(123,IEN,0),"^",7) ;DATE OF REQUEST
. . . . S GMRCREM=$P($G(^GMR(123,IEN,12)),"^",6)
. . . . S ^TMP("GMRCRPT",$J,GMRCSRT1,GMRCSRT2,IEN)=IEN_"|"_^GMR(123,IEN,0)_"^"_GMRCREM
. . . ;
. . . ; If no patient location & NO Ordering Facility, then
. . . ; check for Routing Facility
. . . I "RB"[GMRCARRY,$$CKSTAT(IEN,GMRCSTAT),'+$P(^GMR(123,IEN,0),"^",4),'+$P(^GMR(123,IEN,0),"^",21),+$P(^GMR(123,IEN,0),"^",23) D Q
. . . . S LOCATION=$P(^GMR(123,IEN,0),"^",23) ;ROUTING FACILITY
. . . . S GMRCSRT1=$$GET1^DIQ(4,LOCATION,.01) ;ROUTING FACILITY
. . . . S GMRCSRT2=$P(^GMR(123,IEN,0),"^",7) ;DATE OF REQUEST
. . . . S GMRCREM=$P($G(^GMR(123,IEN,12)),"^",6)
. . . . S ^TMP("GMRCRPT",$J,GMRCSRT1,GMRCSRT2,IEN)=IEN_"|"_^GMR(123,IEN,0)_"^"_GMRCREM
; Get location list from GMRCARRY and then go to global using location
I GMRCARRY(1)="ALL" Q
F S GMRCCNTR=$O(GMRCARRY(GMRCCNTR)) Q:'GMRCCNTR D
. S LOCATION=$P(GMRCARRY(GMRCCNTR),"^",1)
. I "LB"[GMRCARRY,$P(GMRCARRY(GMRCCNTR),"^",3)=44 D
. . N IEN S IEN=0
. . F S IEN=$O(^GMR(123,"AL",LOCATION,IEN)) Q:IEN'>0 D
. . . I $P(^GMR(123,IEN,0),"^",7)>GMRCDT1,$P(^GMR(123,IEN,0),"^",7)<GMRCDT2,$$CKSTAT(IEN,GMRCSTAT) D
. . . . S GMRCSRT1=$P(GMRCARRY(GMRCCNTR),"^",2) ; Patient Location
. . . . S GMRCSRT2=$P(^GMR(123,IEN,0),"^",7) ; DATE OF REQUEST
. . . . S ^TMP("GMRCRPT",$J,GMRCSRT1,GMRCSRT2,IEN)=IEN_"|"_^GMR(123,IEN,0)
. I "RB"[GMRCARRY,$P(GMRCARRY(GMRCCNTR),"^",3)=4 D
. . S GMRCLOC1=GMRCDT1,GMRCLOC2=GMRCDT2
. . F S GMRCLOC1=$O(^GMR(123,"E",GMRCLOC1)) Q:GMRCLOC1>GMRCLOC2 Q:GMRCLOC1="" D
. . . N IEN S IEN=0
. . . F S IEN=$O(^GMR(123,"E",GMRCLOC1,IEN)) Q:IEN'>0 D
. . . . I $$CKSTAT(IEN,GMRCSTAT),$P($G(^GMR(123,IEN,12)),"^",5)="F",+$P($G(^GMR(123,IEN,0)),"^",21)=LOCATION D Q
. . . . . S GMRCSRT1=$P(GMRCARRY(GMRCCNTR),"^",2)
. . . . . S GMRCSRT2=$P(^GMR(123,IEN,0),"^",7)
. . . . . S ^TMP("GMRCRPT",$J,GMRCSRT1,GMRCSRT2,IEN)=IEN_"|"_^GMR(123,IEN,0)
. . . . I $$CKSTAT(IEN,GMRCSTAT),$P($G(^GMR(123,IEN,12)),"^",5)="F",'+$P(^GMR(123,IEN,0),"^",21),+$P($G(^GMR(123,IEN,0)),"^",23)=LOCATION D Q
. . . . . S GMRCSRT1=$P(GMRCARRY(GMRCCNTR),"^",2)
. . . . . S GMRCSRT2=$P(^GMR(123,IEN,0),"^",7)
. . . . . S ^TMP("GMRCRPT",$J,GMRCSRT1,GMRCSRT2,IEN)=IEN_"|"_^GMR(123,IEN,0)
Q
BLDPROC(GMRCARRY) ; Build ^TMP were search was on procedure.
K ^TMP("GMRCRPT",$J)
N GMRCCNTR,PROCEDUR,GMRCSRT1,GMRCSRT2,GMRCPRC1,GMRCPRC2,IEN,GMRCREM
S GMRCCNTR=0
; get all Procedures by date range
I GMRCARRY(1)="ALL" D
. S GMRCPRC1=GMRCDT1,GMRCPRC2=GMRCDT2
. F S GMRCPRC1=$O(^GMR(123,"E",GMRCPRC1)) Q:GMRCPRC1>GMRCPRC2 Q:GMRCPRC1="" D
. . S IEN=0
. . F S IEN=$O(^GMR(123,"E",GMRCPRC1,IEN)) Q:IEN'>0 D
. . . I $$CKSTAT(IEN,GMRCSTAT) D ; Ck Status
. . . . I $P(^GMR(123,IEN,0),"^",8)>"" D ; Ck for Proc
. . . . . S PROCEDUR=$P($P(^GMR(123,IEN,0),"^",8),";",1)
. . . . . S GMRCSRT1=$$GET1^DIQ(123.3,PROCEDUR,.01) ;Procedure
. . . . . S GMRCSRT2=$P(^GMR(123,IEN,0),"^",7) ;Req Date
. . . . . S GMRCREM=$P($G(^GMR(123,IEN,12)),"^",6)
. . . . . S ^TMP("GMRCRPT",$J,GMRCSRT1,GMRCSRT2,IEN)=IEN_"|"_^GMR(123,IEN,0)_"^"_GMRCREM
; Get each procedure from GMRCARRY and then go to global using procedure
I GMRCARRY(1)="ALL" Q
F S GMRCCNTR=$O(GMRCARRY(GMRCCNTR)) Q:'GMRCCNTR D
. S PROCEDUR=$P(GMRCARRY(GMRCCNTR),"^",1)
. N IEN S IEN=0
. F S IEN=$O(^GMR(123,"AP",PROCEDUR_";GMR(123.3,",IEN)) Q:IEN'>0 D
. . I $P(^GMR(123,IEN,0),"^",7)>GMRCDT1,$P(^GMR(123,IEN,0),"^",7)<GMRCDT2,$$CKSTAT(IEN,GMRCSTAT) D
. . . S GMRCSRT1=$P(GMRCARRY(GMRCCNTR),"^",2) ; PROCEDURE TYPE
. . . S GMRCSRT2=$P(^GMR(123,IEN,0),"^",7) ; DATE OF REQUEST
. . . S GMRCREM=$P($G(^GMR(123,IEN,12)),"^",6)
. . . S ^TMP("GMRCRPT",$J,GMRCSRT1,GMRCSRT2,IEN)=IEN_"|"_^GMR(123,IEN,0)_"^"_GMRCREM
Q
BLDPROV(GMRCARRY) ; Build ^TMP were search was on provider.
K ^TMP("GMRCRPT",$J)
N GMRCCNTR,PROVIDER,GMRCSRT1,GMRCSRT2,GMRCPRV1,GMRCPRV2,IEN
N GMRCPROV
S GMRCCNTR=0
; get all providers by date range
I GMRCARRY(1)="ALL" D
. S GMRCPRV1=GMRCDT1,GMRCPRV2=GMRCDT2
. F S GMRCPRV1=$O(^GMR(123,"E",GMRCPRV1)) Q:GMRCPRV1>GMRCPRV2 Q:GMRCPRV1="" D
. . S IEN=0
. . F S IEN=$O(^GMR(123,"E",GMRCPRV1,IEN)) Q:IEN'>0 D
. . . ; Provider not null
. . . I "LB"[GMRCARRY,$$CKSTAT(IEN,GMRCSTAT) D
. . . . I +$P(^GMR(123,IEN,0),"^",14) D
. . . . . S GMRCPROV=$P(^GMR(123,IEN,0),"^",14) ; SENDING PROVIDER
. . . . . S GMRCSRT1=$$GET1^DIQ(200,GMRCPROV,.01) ; SENDING PROVIDER
. . . . . S GMRCSRT2=$P(^GMR(123,IEN,0),"^",7) ; DATE OF REQUEST
. . . . . S ^TMP("GMRCRPT",$J,GMRCSRT1,GMRCSRT2,IEN)=IEN_"|"_^GMR(123,IEN,0)
. . . ; Provider null and REMOTE ORDERING PROVIDER not
. . . I "RB"[GMRCARRY,$$CKSTAT(IEN,GMRCSTAT) D
. . . . I '+$P(^GMR(123,IEN,0),"^",14),$P($G(^GMR(123,IEN,12)),"^",6)'="" D
. . . . . S GMRCPROV=$P($G(^GMR(123,IEN,12)),"^",6)
. . . . . S GMRCSRT1=GMRCPROV
. . . . . S GMRCSRT2=$P(^GMR(123,IEN,0),"^",7) ; DATE OF REQUEST
. . . . . S ^TMP("GMRCRPT",$J,GMRCSRT1,GMRCSRT2,IEN)=IEN_"|"_^GMR(123,IEN,0)_"^"_GMRCPROV
; Get provider list from GMRCARRY and then go to global using provider
I GMRCARRY(1)="ALL" Q
F S GMRCCNTR=$O(GMRCARRY(GMRCCNTR)) Q:'GMRCCNTR D
. S PROVIDER=$P(GMRCARRY(GMRCCNTR),"^",1)
. I "LB"[GMRCARRY,$P(GMRCARRY(GMRCCNTR),"^",3)=200 D
. . S IEN=0
. . F S IEN=$O(^GMR(123,"G",PROVIDER,IEN)) Q:IEN'>0 D
. . . I $P(^GMR(123,IEN,0),"^",7)>GMRCDT1,$P(^GMR(123,IEN,0),"^",7)<GMRCDT2,$$CKSTAT(IEN,GMRCSTAT) D
. . . . S GMRCSRT1=$P(GMRCARRY(GMRCCNTR),"^",2) ; SENDING PROVIDER
. . . . S GMRCSRT2=$P(^GMR(123,IEN,0),"^",7) ; DATE OF REQUEST
. . . . S ^TMP("GMRCRPT",$J,GMRCSRT1,GMRCSRT2,IEN)=IEN_"|"_^GMR(123,IEN,0)
. I "RB"[GMRCARRY,'$P(GMRCARRY(GMRCCNTR),"^",2) D
. . S IEN=0
. . F S IEN=$O(^GMR(123,"AIP",PROVIDER,IEN)) Q:IEN'>0 D
. . . I $P(^GMR(123,IEN,0),"^",7)>GMRCDT1,$P(^GMR(123,IEN,0),"^",7)<GMRCDT2,$$CKSTAT(IEN,GMRCSTAT) D
. . . . S GMRCSRT1=$P(GMRCARRY(GMRCCNTR),"^",1)
. . . . S GMRCSRT2=$P(^GMR(123,IEN,0),"^",7)
. . . . S ^TMP("GMRCRPT",$J,GMRCSRT1,GMRCSRT2,IEN)=IEN_"|"_^GMR(123,IEN,0)_"^"_PROVIDER
Q
CKSTAT(IEN,GMRCSTAT) ; Does entry have selected status
; Input:
; IEN = File #123 IEN
; GMRCSTAT = Selected status(es)
; Output:
; GMRCKS = Result (1:yes; 0:no)
N GMRCKS,GMRCS,LOOP,STATUS
S GMRCKS=0
S GMRCS=+$P(^GMR(123,IEN,0),"^",12)
F LOOP=1:1:$L(GMRCSTAT,",") S STATUS=$P(GMRCSTAT,",",LOOP) Q:GMRCKS D
. I STATUS=GMRCS S GMRCKS=1
Q GMRCKS
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCPSL2 9228 printed Sep 23, 2025@19:22:57 Page 2
GMRCPSL2 ;SLC/MA - Special Consult Reports;9/21/01 05:25 ;1/17/02 18:19
+1 ;;3.0;CONSULT/REQUEST TRACKING;**23,22**;DEC 27, 1997
+2 ; This routine is used by GMRCPSL1 to build ^TMP("GMRCRPT",$J)
+3 ; which will be passed to GMRCPSL3.
PRINT(GMRCSRCH,GMRCARRY,GMRCDT1,GMRCDT2,GMRCSTAT,GMRCRPT,GMRCBRK) ; Untasked Print
PRTTSK ; Print report
+1 ; GMRCARRY = Array contains search values.
+2 ; GMRCSRCH = Indicates which field to search on
+3 ; GMRCDT1 = Start date
+4 ; GMRCDT2 = Stop date
+5 ; GMRCSTAT = CPRS status to include in report
+6 ; SUBTOT = Counter for different groups
+7 ; GMRCRPT = 80 - 132 character report & data only output
+8 ; GMRCBRK = Print page break between sub-totals <Y-N>
+9 ; TOTCNTR = Count for total records
+10 ;BLD PROVIDER ^TMP(GLOBAL)
IF GMRCSRCH=1
DO BLDPROV(.GMRCARRY)
+11 ;BLD LOCATION ^TMP(GLOBAL)
IF GMRCSRCH=2
DO BLDLOC(.GMRCARRY)
+12 ;BLD PROCEDURE ^TMP(GLOBAL)
IF GMRCSRCH=3
DO BLDPROC(.GMRCARRY)
+13 NEW TOTCNTR,SUBTOT
SET (SUBTOT,TOTCNTR)=0
+14 IF GMRCRPT=1
DO REPORT80^GMRCPSL3(.SUBTOT,.TOTCNTR,GMRCSRCH,GMRCBRK)
+15 IF GMRCRPT=2
DO REPORT32^GMRCPSL3(.SUBTOT,.TOTCNTR,GMRCSRCH,GMRCBRK)
+16 IF GMRCRPT=3
DO DATAONLY^GMRCPSL4
QUIT
+17 WRITE !!,"SUB TOTAL= ",SUBTOT,!
+18 WRITE !,"TOTAL RECORDS= ",TOTCNTR
+19 DO ^%ZISC
+20 KILL ^TMP("GMRCRPT",$JOB)
+21 IF ($EXTRACT(IOST)="C")
Begin DoDot:1
+22 NEW DIR
+23 SET DIR(0)="E"
+24 WRITE !
+25 DO ^DIR
KILL DIR
End DoDot:1
+26 QUIT
+27 ;
BLDLOC(GMRCARRY) ; Build ^TMP were search was on location.
+1 KILL ^TMP("GMRCRPT",$JOB)
+2 NEW GMRCCNTR,LOCATION,GMRCSRT1,GMRCSRT2,GMRCLOC1,GMRCLOC2,IEN
+3 NEW GMRCREM,LOCPN
+4 SET GMRCCNTR=0
+5 ;
+6 ; get all Locations by date range
+7 IF GMRCARRY(1)="ALL"
Begin DoDot:1
+8 SET GMRCLOC1=GMRCDT1
SET GMRCLOC2=GMRCDT2
+9 FOR
SET GMRCLOC1=$ORDER(^GMR(123,"E",GMRCLOC1))
if GMRCLOC1>GMRCLOC2
QUIT
if GMRCLOC1=""
QUIT
Begin DoDot:2
+10 SET IEN=0
+11 FOR
SET IEN=$ORDER(^GMR(123,"E",GMRCLOC1,IEN))
if IEN'>0
QUIT
Begin DoDot:3
+12 ;
+13 ; Check for Patient Location
+14 IF "LB"[GMRCARRY
IF $$CKSTAT(IEN,GMRCSTAT)
IF +$PIECE(^GMR(123,IEN,0),"^",4)
Begin DoDot:4
+15 ; PATIENT LOCATION
SET LOCATION=$PIECE(^GMR(123,IEN,0),"^",4)
+16 ; PATIENT LOCATION
SET GMRCSRT1=$$GET1^DIQ(44,LOCATION,.01)
+17 ; DATE OF REQUEST
SET GMRCSRT2=$PIECE(^GMR(123,IEN,0),"^",7)
+18 SET ^TMP("GMRCRPT",$JOB,GMRCSRT1,GMRCSRT2,IEN)=IEN_"|"_^GMR(123,IEN,0)
End DoDot:4
QUIT
+19 ;
+20 ; If no patient location, check for Ordering Facility
+21 IF $$CKSTAT(IEN,GMRCSTAT)
IF '+$PIECE(^GMR(123,IEN,0),"^",4)
IF +$PIECE(^GMR(123,IEN,0),"^",21)
IF ("L"[GMRCARRY&'+$PIECE(^GMR(123,IEN,0),"^",23)!("RB"[GMRCARRY&+$PIECE(^GMR(123,IEN,0),"^",23)))
Begin DoDot:4
+22 ;ORDERING FACILITY
SET LOCATION=$PIECE(^GMR(123,IEN,0),"^",21)
+23 ;ORDERING FACILITY
SET GMRCSRT1=$$GET1^DIQ(4,LOCATION,.01)
+24 ;DATE OF REQUEST
SET GMRCSRT2=$PIECE(^GMR(123,IEN,0),"^",7)
+25 SET GMRCREM=$PIECE($GET(^GMR(123,IEN,12)),"^",6)
+26 SET ^TMP("GMRCRPT",$JOB,GMRCSRT1,GMRCSRT2,IEN)=IEN_"|"_^GMR(123,IEN,0)_"^"_GMRCREM
End DoDot:4
QUIT
+27 ;
+28 ; If no patient location & NO Ordering Facility, then
+29 ; check for Routing Facility
+30 IF "RB"[GMRCARRY
IF $$CKSTAT(IEN,GMRCSTAT)
IF '+$PIECE(^GMR(123,IEN,0),"^",4)
IF '+$PIECE(^GMR(123,IEN,0),"^",21)
IF +$PIECE(^GMR(123,IEN,0),"^",23)
Begin DoDot:4
+31 ;ROUTING FACILITY
SET LOCATION=$PIECE(^GMR(123,IEN,0),"^",23)
+32 ;ROUTING FACILITY
SET GMRCSRT1=$$GET1^DIQ(4,LOCATION,.01)
+33 ;DATE OF REQUEST
SET GMRCSRT2=$PIECE(^GMR(123,IEN,0),"^",7)
+34 SET GMRCREM=$PIECE($GET(^GMR(123,IEN,12)),"^",6)
+35 SET ^TMP("GMRCRPT",$JOB,GMRCSRT1,GMRCSRT2,IEN)=IEN_"|"_^GMR(123,IEN,0)_"^"_GMRCREM
End DoDot:4
QUIT
End DoDot:3
End DoDot:2
End DoDot:1
+36 ; Get location list from GMRCARRY and then go to global using location
+37 IF GMRCARRY(1)="ALL"
QUIT
+38 FOR
SET GMRCCNTR=$ORDER(GMRCARRY(GMRCCNTR))
if 'GMRCCNTR
QUIT
Begin DoDot:1
+39 SET LOCATION=$PIECE(GMRCARRY(GMRCCNTR),"^",1)
+40 IF "LB"[GMRCARRY
IF $PIECE(GMRCARRY(GMRCCNTR),"^",3)=44
Begin DoDot:2
+41 NEW IEN
SET IEN=0
+42 FOR
SET IEN=$ORDER(^GMR(123,"AL",LOCATION,IEN))
if IEN'>0
QUIT
Begin DoDot:3
+43 IF $PIECE(^GMR(123,IEN,0),"^",7)>GMRCDT1
IF $PIECE(^GMR(123,IEN,0),"^",7)<GMRCDT2
IF $$CKSTAT(IEN,GMRCSTAT)
Begin DoDot:4
+44 ; Patient Location
SET GMRCSRT1=$PIECE(GMRCARRY(GMRCCNTR),"^",2)
+45 ; DATE OF REQUEST
SET GMRCSRT2=$PIECE(^GMR(123,IEN,0),"^",7)
+46 SET ^TMP("GMRCRPT",$JOB,GMRCSRT1,GMRCSRT2,IEN)=IEN_"|"_^GMR(123,IEN,0)
End DoDot:4
End DoDot:3
End DoDot:2
+47 IF "RB"[GMRCARRY
IF $PIECE(GMRCARRY(GMRCCNTR),"^",3)=4
Begin DoDot:2
+48 SET GMRCLOC1=GMRCDT1
SET GMRCLOC2=GMRCDT2
+49 FOR
SET GMRCLOC1=$ORDER(^GMR(123,"E",GMRCLOC1))
if GMRCLOC1>GMRCLOC2
QUIT
if GMRCLOC1=""
QUIT
Begin DoDot:3
+50 NEW IEN
SET IEN=0
+51 FOR
SET IEN=$ORDER(^GMR(123,"E",GMRCLOC1,IEN))
if IEN'>0
QUIT
Begin DoDot:4
+52 IF $$CKSTAT(IEN,GMRCSTAT)
IF $PIECE($GET(^GMR(123,IEN,12)),"^",5)="F"
IF +$PIECE($GET(^GMR(123,IEN,0)),"^",21)=LOCATION
Begin DoDot:5
+53 SET GMRCSRT1=$PIECE(GMRCARRY(GMRCCNTR),"^",2)
+54 SET GMRCSRT2=$PIECE(^GMR(123,IEN,0),"^",7)
+55 SET ^TMP("GMRCRPT",$JOB,GMRCSRT1,GMRCSRT2,IEN)=IEN_"|"_^GMR(123,IEN,0)
End DoDot:5
QUIT
+56 IF $$CKSTAT(IEN,GMRCSTAT)
IF $PIECE($GET(^GMR(123,IEN,12)),"^",5)="F"
IF '+$PIECE(^GMR(123,IEN,0),"^",21)
IF +$PIECE($GET(^GMR(123,IEN,0)),"^",23)=LOCATION
Begin DoDot:5
+57 SET GMRCSRT1=$PIECE(GMRCARRY(GMRCCNTR),"^",2)
+58 SET GMRCSRT2=$PIECE(^GMR(123,IEN,0),"^",7)
+59 SET ^TMP("GMRCRPT",$JOB,GMRCSRT1,GMRCSRT2,IEN)=IEN_"|"_^GMR(123,IEN,0)
End DoDot:5
QUIT
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+60 QUIT
BLDPROC(GMRCARRY) ; Build ^TMP were search was on procedure.
+1 KILL ^TMP("GMRCRPT",$JOB)
+2 NEW GMRCCNTR,PROCEDUR,GMRCSRT1,GMRCSRT2,GMRCPRC1,GMRCPRC2,IEN,GMRCREM
+3 SET GMRCCNTR=0
+4 ; get all Procedures by date range
+5 IF GMRCARRY(1)="ALL"
Begin DoDot:1
+6 SET GMRCPRC1=GMRCDT1
SET GMRCPRC2=GMRCDT2
+7 FOR
SET GMRCPRC1=$ORDER(^GMR(123,"E",GMRCPRC1))
if GMRCPRC1>GMRCPRC2
QUIT
if GMRCPRC1=""
QUIT
Begin DoDot:2
+8 SET IEN=0
+9 FOR
SET IEN=$ORDER(^GMR(123,"E",GMRCPRC1,IEN))
if IEN'>0
QUIT
Begin DoDot:3
+10 ; Ck Status
IF $$CKSTAT(IEN,GMRCSTAT)
Begin DoDot:4
+11 ; Ck for Proc
IF $PIECE(^GMR(123,IEN,0),"^",8)>""
Begin DoDot:5
+12 SET PROCEDUR=$PIECE($PIECE(^GMR(123,IEN,0),"^",8),";",1)
+13 ;Procedure
SET GMRCSRT1=$$GET1^DIQ(123.3,PROCEDUR,.01)
+14 ;Req Date
SET GMRCSRT2=$PIECE(^GMR(123,IEN,0),"^",7)
+15 SET GMRCREM=$PIECE($GET(^GMR(123,IEN,12)),"^",6)
+16 SET ^TMP("GMRCRPT",$JOB,GMRCSRT1,GMRCSRT2,IEN)=IEN_"|"_^GMR(123,IEN,0)_"^"_GMRCREM
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+17 ; Get each procedure from GMRCARRY and then go to global using procedure
+18 IF GMRCARRY(1)="ALL"
QUIT
+19 FOR
SET GMRCCNTR=$ORDER(GMRCARRY(GMRCCNTR))
if 'GMRCCNTR
QUIT
Begin DoDot:1
+20 SET PROCEDUR=$PIECE(GMRCARRY(GMRCCNTR),"^",1)
+21 NEW IEN
SET IEN=0
+22 FOR
SET IEN=$ORDER(^GMR(123,"AP",PROCEDUR_";GMR(123.3,",IEN))
if IEN'>0
QUIT
Begin DoDot:2
+23 IF $PIECE(^GMR(123,IEN,0),"^",7)>GMRCDT1
IF $PIECE(^GMR(123,IEN,0),"^",7)<GMRCDT2
IF $$CKSTAT(IEN,GMRCSTAT)
Begin DoDot:3
+24 ; PROCEDURE TYPE
SET GMRCSRT1=$PIECE(GMRCARRY(GMRCCNTR),"^",2)
+25 ; DATE OF REQUEST
SET GMRCSRT2=$PIECE(^GMR(123,IEN,0),"^",7)
+26 SET GMRCREM=$PIECE($GET(^GMR(123,IEN,12)),"^",6)
+27 SET ^TMP("GMRCRPT",$JOB,GMRCSRT1,GMRCSRT2,IEN)=IEN_"|"_^GMR(123,IEN,0)_"^"_GMRCREM
End DoDot:3
End DoDot:2
End DoDot:1
+28 QUIT
BLDPROV(GMRCARRY) ; Build ^TMP were search was on provider.
+1 KILL ^TMP("GMRCRPT",$JOB)
+2 NEW GMRCCNTR,PROVIDER,GMRCSRT1,GMRCSRT2,GMRCPRV1,GMRCPRV2,IEN
+3 NEW GMRCPROV
+4 SET GMRCCNTR=0
+5 ; get all providers by date range
+6 IF GMRCARRY(1)="ALL"
Begin DoDot:1
+7 SET GMRCPRV1=GMRCDT1
SET GMRCPRV2=GMRCDT2
+8 FOR
SET GMRCPRV1=$ORDER(^GMR(123,"E",GMRCPRV1))
if GMRCPRV1>GMRCPRV2
QUIT
if GMRCPRV1=""
QUIT
Begin DoDot:2
+9 SET IEN=0
+10 FOR
SET IEN=$ORDER(^GMR(123,"E",GMRCPRV1,IEN))
if IEN'>0
QUIT
Begin DoDot:3
+11 ; Provider not null
+12 IF "LB"[GMRCARRY
IF $$CKSTAT(IEN,GMRCSTAT)
Begin DoDot:4
+13 IF +$PIECE(^GMR(123,IEN,0),"^",14)
Begin DoDot:5
+14 ; SENDING PROVIDER
SET GMRCPROV=$PIECE(^GMR(123,IEN,0),"^",14)
+15 ; SENDING PROVIDER
SET GMRCSRT1=$$GET1^DIQ(200,GMRCPROV,.01)
+16 ; DATE OF REQUEST
SET GMRCSRT2=$PIECE(^GMR(123,IEN,0),"^",7)
+17 SET ^TMP("GMRCRPT",$JOB,GMRCSRT1,GMRCSRT2,IEN)=IEN_"|"_^GMR(123,IEN,0)
End DoDot:5
End DoDot:4
+18 ; Provider null and REMOTE ORDERING PROVIDER not
+19 IF "RB"[GMRCARRY
IF $$CKSTAT(IEN,GMRCSTAT)
Begin DoDot:4
+20 IF '+$PIECE(^GMR(123,IEN,0),"^",14)
IF $PIECE($GET(^GMR(123,IEN,12)),"^",6)'=""
Begin DoDot:5
+21 SET GMRCPROV=$PIECE($GET(^GMR(123,IEN,12)),"^",6)
+22 SET GMRCSRT1=GMRCPROV
+23 ; DATE OF REQUEST
SET GMRCSRT2=$PIECE(^GMR(123,IEN,0),"^",7)
+24 SET ^TMP("GMRCRPT",$JOB,GMRCSRT1,GMRCSRT2,IEN)=IEN_"|"_^GMR(123,IEN,0)_"^"_GMRCPROV
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+25 ; Get provider list from GMRCARRY and then go to global using provider
+26 IF GMRCARRY(1)="ALL"
QUIT
+27 FOR
SET GMRCCNTR=$ORDER(GMRCARRY(GMRCCNTR))
if 'GMRCCNTR
QUIT
Begin DoDot:1
+28 SET PROVIDER=$PIECE(GMRCARRY(GMRCCNTR),"^",1)
+29 IF "LB"[GMRCARRY
IF $PIECE(GMRCARRY(GMRCCNTR),"^",3)=200
Begin DoDot:2
+30 SET IEN=0
+31 FOR
SET IEN=$ORDER(^GMR(123,"G",PROVIDER,IEN))
if IEN'>0
QUIT
Begin DoDot:3
+32 IF $PIECE(^GMR(123,IEN,0),"^",7)>GMRCDT1
IF $PIECE(^GMR(123,IEN,0),"^",7)<GMRCDT2
IF $$CKSTAT(IEN,GMRCSTAT)
Begin DoDot:4
+33 ; SENDING PROVIDER
SET GMRCSRT1=$PIECE(GMRCARRY(GMRCCNTR),"^",2)
+34 ; DATE OF REQUEST
SET GMRCSRT2=$PIECE(^GMR(123,IEN,0),"^",7)
+35 SET ^TMP("GMRCRPT",$JOB,GMRCSRT1,GMRCSRT2,IEN)=IEN_"|"_^GMR(123,IEN,0)
End DoDot:4
End DoDot:3
End DoDot:2
+36 IF "RB"[GMRCARRY
IF '$PIECE(GMRCARRY(GMRCCNTR),"^",2)
Begin DoDot:2
+37 SET IEN=0
+38 FOR
SET IEN=$ORDER(^GMR(123,"AIP",PROVIDER,IEN))
if IEN'>0
QUIT
Begin DoDot:3
+39 IF $PIECE(^GMR(123,IEN,0),"^",7)>GMRCDT1
IF $PIECE(^GMR(123,IEN,0),"^",7)<GMRCDT2
IF $$CKSTAT(IEN,GMRCSTAT)
Begin DoDot:4
+40 SET GMRCSRT1=$PIECE(GMRCARRY(GMRCCNTR),"^",1)
+41 SET GMRCSRT2=$PIECE(^GMR(123,IEN,0),"^",7)
+42 SET ^TMP("GMRCRPT",$JOB,GMRCSRT1,GMRCSRT2,IEN)=IEN_"|"_^GMR(123,IEN,0)_"^"_PROVIDER
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+43 QUIT
CKSTAT(IEN,GMRCSTAT) ; Does entry have selected status
+1 ; Input:
+2 ; IEN = File #123 IEN
+3 ; GMRCSTAT = Selected status(es)
+4 ; Output:
+5 ; GMRCKS = Result (1:yes; 0:no)
+6 NEW GMRCKS,GMRCS,LOOP,STATUS
+7 SET GMRCKS=0
+8 SET GMRCS=+$PIECE(^GMR(123,IEN,0),"^",12)
+9 FOR LOOP=1:1:$LENGTH(GMRCSTAT,",")
SET STATUS=$PIECE(GMRCSTAT,",",LOOP)
if GMRCKS
QUIT
Begin DoDot:1
+10 IF STATUS=GMRCS
SET GMRCKS=1
End DoDot:1
+11 QUIT GMRCKS
