GMRCPSL2 ;SLC/MA - Special Consult Reports;07-Dec-2011 14:47;DU
;;3.0;CONSULT/REQUEST TRACKING;**23,22,1002**;DEC 27, 1997;Build 1
;
; Modified - IHS/MSC/MGH - 09/20/2011 - New TEST API
; 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,GMRTST) ; 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>
; GMRTST = Includ or not include test pts Patch 1002
; 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,CHK
S GMRCCNTR=0
;
; get all Locations by date range
I GMRCARRY(1)="ALL" D
. S GMRCLOC1=GMRCDT1,GMRCLOC2=GMRCDT2,CHK=0
. 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 CHK=$$TEST(IEN,GMRTST)
. . . . Q:+CHK
. . . . 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 CHK=$$TEST(IEN,GMRTST)
. . . . Q:+CHK
. . . . 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 CHK=$$TEST(IEN,GMRTST)
. . . . Q:+CHK
. . . . 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 CHK=$$TEST(IEN,GMRTST)
. . . . Q:+CHK
. . . . 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 CHK=$$TEST(IEN,GMRTST)
. . . . . Q:+CHK
. . . . . 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 CHK=$$TEST(IEN,GMRTST)
. . . . . Q:+CHK
. . . . . 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 CHK=$$TEST(IEN,GMRTST)
. . . . . Q:+CHK
. . . . . 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 CHK=$$TEST(IEN,GMRTST)
. . . Q:+CHK
. . . 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 CHK=$$TEST(IEN,GMRTST)
. . . . . Q:+CHK
. . . . . 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 CHK=$$TEST(IEN,GMRTST)
. . . . . Q:+CHK
. . . . . 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 CHK=$$TEST(IEN,GMRTST)
. . . . Q:+CHK
. . . . 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 CHK=$$TEST(IEN,GMRTST)
. . . . Q:+CHK
. . . . 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
TEST(IEN,TST) ;Check to see if this consult shold be included
N RESULT,NODE,SSN
S RESULT=0
S NODE=^GMR(123,IEN,0)
S SSN=$E($P(^DPT($P(NODE,"^",2),0),"^",9),1,5)
I SSN="00000"&(GMRTST="E") S RESULT=1
I SSN'="00000"&(GMRTST="D") S RESULT=1
Q RESULT
GMRCPSL2 ;SLC/MA - Special Consult Reports;07-Dec-2011 14:47;DU
+1 ;;3.0;CONSULT/REQUEST TRACKING;**23,22,1002**;DEC 27, 1997;Build 1
+2 ;
+3 ; Modified - IHS/MSC/MGH - 09/20/2011 - New TEST API
+4 ; This routine is used by GMRCPSL1 to build ^TMP("GMRCRPT",$J)
+5 ; which will be passed to GMRCPSL3.
PRINT(GMRCSRCH,GMRCARRY,GMRCDT1,GMRCDT2,GMRCSTAT,GMRCRPT,GMRCBRK,GMRTST) ; 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 ; GMRTST = Includ or not include test pts Patch 1002
+10 ; TOTCNTR = Count for total records
+11 ;BLD PROVIDER ^TMP(GLOBAL)
IF GMRCSRCH=1
DO BLDPROV(.GMRCARRY)
+12 ;BLD LOCATION ^TMP(GLOBAL)
IF GMRCSRCH=2
DO BLDLOC(.GMRCARRY)
+13 ;BLD PROCEDURE ^TMP(GLOBAL)
IF GMRCSRCH=3
DO BLDPROC(.GMRCARRY)
+14 NEW TOTCNTR,SUBTOT
SET (SUBTOT,TOTCNTR)=0
+15 IF GMRCRPT=1
DO REPORT80^GMRCPSL3(.SUBTOT,.TOTCNTR,GMRCSRCH,GMRCBRK)
+16 IF GMRCRPT=2
DO REPORT32^GMRCPSL3(.SUBTOT,.TOTCNTR,GMRCSRCH,GMRCBRK)
+17 IF GMRCRPT=3
DO DATAONLY^GMRCPSL4
QUIT
+18 WRITE !!,"SUB TOTAL= ",SUBTOT,!
+19 WRITE !,"TOTAL RECORDS= ",TOTCNTR
+20 DO ^%ZISC
+21 KILL ^TMP("GMRCRPT",$JOB)
+22 IF ($EXTRACT(IOST)="C")
Begin DoDot:1
+23 NEW DIR
+24 SET DIR(0)="E"
+25 WRITE !
+26 DO ^DIR
KILL DIR
End DoDot:1
+27 QUIT
+28 ;
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,CHK
+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
SET CHK=0
+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 SET CHK=$$TEST(IEN,GMRTST)
+16 IF +CHK
QUIT
+17 ; PATIENT LOCATION
SET LOCATION=$PIECE(^GMR(123,IEN,0),"^",4)
+18 ; PATIENT LOCATION
SET GMRCSRT1=$$GET1^DIQ(44,LOCATION,.01)
+19 ; DATE OF REQUEST
SET GMRCSRT2=$PIECE(^GMR(123,IEN,0),"^",7)
+20 SET ^TMP("GMRCRPT",$JOB,GMRCSRT1,GMRCSRT2,IEN)=IEN_"|"_^GMR(123,IEN,0)
End DoDot:4
QUIT
+21 ;
+22 ; If no patient location, check for Ordering Facility
+23 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
+24 SET CHK=$$TEST(IEN,GMRTST)
+25 IF +CHK
QUIT
+26 ;ORDERING FACILITY
SET LOCATION=$PIECE(^GMR(123,IEN,0),"^",21)
+27 ;ORDERING FACILITY
SET GMRCSRT1=$$GET1^DIQ(4,LOCATION,.01)
+28 ;DATE OF REQUEST
SET GMRCSRT2=$PIECE(^GMR(123,IEN,0),"^",7)
+29 SET GMRCREM=$PIECE($GET(^GMR(123,IEN,12)),"^",6)
+30 SET ^TMP("GMRCRPT",$JOB,GMRCSRT1,GMRCSRT2,IEN)=IEN_"|"_^GMR(123,IEN,0)_"^"_GMRCREM
End DoDot:4
QUIT
+31 ;
+32 ; If no patient location & NO Ordering Facility, then
+33 ; check for Routing Facility
+34 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
+35 SET CHK=$$TEST(IEN,GMRTST)
+36 IF +CHK
QUIT
+37 ;ROUTING FACILITY
SET LOCATION=$PIECE(^GMR(123,IEN,0),"^",23)
+38 ;ROUTING FACILITY
SET GMRCSRT1=$$GET1^DIQ(4,LOCATION,.01)
+39 ;DATE OF REQUEST
SET GMRCSRT2=$PIECE(^GMR(123,IEN,0),"^",7)
+40 SET GMRCREM=$PIECE($GET(^GMR(123,IEN,12)),"^",6)
+41 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
+42 ; Get location list from GMRCARRY and then go to global using location
+43 IF GMRCARRY(1)="ALL"
QUIT
+44 FOR
SET GMRCCNTR=$ORDER(GMRCARRY(GMRCCNTR))
IF 'GMRCCNTR
QUIT
Begin DoDot:1
+45 SET LOCATION=$PIECE(GMRCARRY(GMRCCNTR),"^",1)
+46 IF "LB"[GMRCARRY
IF $PIECE(GMRCARRY(GMRCCNTR),"^",3)=44
Begin DoDot:2
+47 NEW IEN
SET IEN=0
+48 FOR
SET IEN=$ORDER(^GMR(123,"AL",LOCATION,IEN))
IF IEN'>0
QUIT
Begin DoDot:3
+49 IF $PIECE(^GMR(123,IEN,0),"^",7)>GMRCDT1
IF $PIECE(^GMR(123,IEN,0),"^",7)<GMRCDT2
IF $$CKSTAT(IEN,GMRCSTAT)
Begin DoDot:4
+50 SET CHK=$$TEST(IEN,GMRTST)
+51 IF +CHK
QUIT
+52 ; Patient Location
SET GMRCSRT1=$PIECE(GMRCARRY(GMRCCNTR),"^",2)
+53 ; DATE OF REQUEST
SET GMRCSRT2=$PIECE(^GMR(123,IEN,0),"^",7)
+54 SET ^TMP("GMRCRPT",$JOB,GMRCSRT1,GMRCSRT2,IEN)=IEN_"|"_^GMR(123,IEN,0)
End DoDot:4
End DoDot:3
End DoDot:2
+55 IF "RB"[GMRCARRY
IF $PIECE(GMRCARRY(GMRCCNTR),"^",3)=4
Begin DoDot:2
+56 SET GMRCLOC1=GMRCDT1
SET GMRCLOC2=GMRCDT2
+57 FOR
SET GMRCLOC1=$ORDER(^GMR(123,"E",GMRCLOC1))
IF GMRCLOC1>GMRCLOC2
QUIT
IF GMRCLOC1=""
QUIT
Begin DoDot:3
+58 NEW IEN
SET IEN=0
+59 FOR
SET IEN=$ORDER(^GMR(123,"E",GMRCLOC1,IEN))
IF IEN'>0
QUIT
Begin DoDot:4
+60 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
+61 SET CHK=$$TEST(IEN,GMRTST)
+62 IF +CHK
QUIT
+63 SET GMRCSRT1=$PIECE(GMRCARRY(GMRCCNTR),"^",2)
+64 SET GMRCSRT2=$PIECE(^GMR(123,IEN,0),"^",7)
+65 SET ^TMP("GMRCRPT",$JOB,GMRCSRT1,GMRCSRT2,IEN)=IEN_"|"_^GMR(123,IEN,0)
End DoDot:5
QUIT
+66 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
+67 SET CHK=$$TEST(IEN,GMRTST)
+68 IF +CHK
QUIT
+69 SET GMRCSRT1=$PIECE(GMRCARRY(GMRCCNTR),"^",2)
+70 SET GMRCSRT2=$PIECE(^GMR(123,IEN,0),"^",7)
+71 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
+72 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 CHK=$$TEST(IEN,GMRTST)
+13 IF +CHK
QUIT
+14 SET PROCEDUR=$PIECE($PIECE(^GMR(123,IEN,0),"^",8),";",1)
+15 ;Procedure
SET GMRCSRT1=$$GET1^DIQ(123.3,PROCEDUR,.01)
+16 ;Req Date
SET GMRCSRT2=$PIECE(^GMR(123,IEN,0),"^",7)
+17 SET GMRCREM=$PIECE($GET(^GMR(123,IEN,12)),"^",6)
+18 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
+19 ; Get each procedure from GMRCARRY and then go to global using procedure
+20 IF GMRCARRY(1)="ALL"
QUIT
+21 FOR
SET GMRCCNTR=$ORDER(GMRCARRY(GMRCCNTR))
IF 'GMRCCNTR
QUIT
Begin DoDot:1
+22 SET PROCEDUR=$PIECE(GMRCARRY(GMRCCNTR),"^",1)
+23 NEW IEN
SET IEN=0
+24 FOR
SET IEN=$ORDER(^GMR(123,"AP",PROCEDUR_";GMR(123.3,",IEN))
IF IEN'>0
QUIT
Begin DoDot:2
+25 IF $PIECE(^GMR(123,IEN,0),"^",7)>GMRCDT1
IF $PIECE(^GMR(123,IEN,0),"^",7)<GMRCDT2
IF $$CKSTAT(IEN,GMRCSTAT)
Begin DoDot:3
+26 SET CHK=$$TEST(IEN,GMRTST)
+27 IF +CHK
QUIT
+28 ; PROCEDURE TYPE
SET GMRCSRT1=$PIECE(GMRCARRY(GMRCCNTR),"^",2)
+29 ; DATE OF REQUEST
SET GMRCSRT2=$PIECE(^GMR(123,IEN,0),"^",7)
+30 SET GMRCREM=$PIECE($GET(^GMR(123,IEN,12)),"^",6)
+31 SET ^TMP("GMRCRPT",$JOB,GMRCSRT1,GMRCSRT2,IEN)=IEN_"|"_^GMR(123,IEN,0)_"^"_GMRCREM
End DoDot:3
End DoDot:2
End DoDot:1
+32 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 SET CHK=$$TEST(IEN,GMRTST)
+15 IF +CHK
QUIT
+16 ; SENDING PROVIDER
SET GMRCPROV=$PIECE(^GMR(123,IEN,0),"^",14)
+17 ; SENDING PROVIDER
SET GMRCSRT1=$$GET1^DIQ(200,GMRCPROV,.01)
+18 ; DATE OF REQUEST
SET GMRCSRT2=$PIECE(^GMR(123,IEN,0),"^",7)
+19 SET ^TMP("GMRCRPT",$JOB,GMRCSRT1,GMRCSRT2,IEN)=IEN_"|"_^GMR(123,IEN,0)
End DoDot:5
End DoDot:4
+20 ; Provider null and REMOTE ORDERING PROVIDER not
+21 IF "RB"[GMRCARRY
IF $$CKSTAT(IEN,GMRCSTAT)
Begin DoDot:4
+22 IF '+$PIECE(^GMR(123,IEN,0),"^",14)
IF $PIECE($GET(^GMR(123,IEN,12)),"^",6)'=""
Begin DoDot:5
+23 SET CHK=$$TEST(IEN,GMRTST)
+24 IF +CHK
QUIT
+25 SET GMRCPROV=$PIECE($GET(^GMR(123,IEN,12)),"^",6)
+26 SET GMRCSRT1=GMRCPROV
+27 ; DATE OF REQUEST
SET GMRCSRT2=$PIECE(^GMR(123,IEN,0),"^",7)
+28 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
+29 ; Get provider list from GMRCARRY and then go to global using provider
+30 IF GMRCARRY(1)="ALL"
QUIT
+31 FOR
SET GMRCCNTR=$ORDER(GMRCARRY(GMRCCNTR))
IF 'GMRCCNTR
QUIT
Begin DoDot:1
+32 SET PROVIDER=$PIECE(GMRCARRY(GMRCCNTR),"^",1)
+33 IF "LB"[GMRCARRY
IF $PIECE(GMRCARRY(GMRCCNTR),"^",3)=200
Begin DoDot:2
+34 SET IEN=0
+35 FOR
SET IEN=$ORDER(^GMR(123,"G",PROVIDER,IEN))
IF IEN'>0
QUIT
Begin DoDot:3
+36 IF $PIECE(^GMR(123,IEN,0),"^",7)>GMRCDT1
IF $PIECE(^GMR(123,IEN,0),"^",7)<GMRCDT2
IF $$CKSTAT(IEN,GMRCSTAT)
Begin DoDot:4
+37 SET CHK=$$TEST(IEN,GMRTST)
+38 IF +CHK
QUIT
+39 ; SENDING PROVIDER
SET GMRCSRT1=$PIECE(GMRCARRY(GMRCCNTR),"^",2)
+40 ; DATE OF REQUEST
SET GMRCSRT2=$PIECE(^GMR(123,IEN,0),"^",7)
+41 SET ^TMP("GMRCRPT",$JOB,GMRCSRT1,GMRCSRT2,IEN)=IEN_"|"_^GMR(123,IEN,0)
End DoDot:4
End DoDot:3
End DoDot:2
+42 IF "RB"[GMRCARRY
IF '$PIECE(GMRCARRY(GMRCCNTR),"^",2)
Begin DoDot:2
+43 SET IEN=0
+44 FOR
SET IEN=$ORDER(^GMR(123,"AIP",PROVIDER,IEN))
IF IEN'>0
QUIT
Begin DoDot:3
+45 IF $PIECE(^GMR(123,IEN,0),"^",7)>GMRCDT1
IF $PIECE(^GMR(123,IEN,0),"^",7)<GMRCDT2
IF $$CKSTAT(IEN,GMRCSTAT)
Begin DoDot:4
+46 SET CHK=$$TEST(IEN,GMRTST)
+47 IF +CHK
QUIT
+48 SET GMRCSRT1=$PIECE(GMRCARRY(GMRCCNTR),"^",1)
+49 SET GMRCSRT2=$PIECE(^GMR(123,IEN,0),"^",7)
+50 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
+51 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
TEST(IEN,TST) ;Check to see if this consult shold be included
+1 NEW RESULT,NODE,SSN
+2 SET RESULT=0
+3 SET NODE=^GMR(123,IEN,0)
+4 SET SSN=$EXTRACT($PIECE(^DPT($PIECE(NODE,"^",2),0),"^",9),1,5)
+5 IF SSN="00000"&(GMRTST="E")
SET RESULT=1
+6 IF SSN'="00000"&(GMRTST="D")
SET RESULT=1
+7 QUIT RESULT
