Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GMRCPSL2

GMRCPSL2.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1.  ; Modified - IHS/MSC/MGH - 09/20/2011 - New TEST API
  1.  ; This routine is used by GMRCPSL1 to build ^TMP("GMRCRPT",$J)
  1.  ; which will be passed to GMRCPSL3.
  1. PRINT(GMRCSRCH,GMRCARRY,GMRCDT1,GMRCDT2,GMRCSTAT,GMRCRPT,GMRCBRK,GMRTST) ; Untasked Print
  1. PRTTSK ; Print report
  1.  ; GMRCARRY = Array contains search values.
  1.  ; GMRCSRCH = Indicates which field to search on
  1.  ; GMRCDT1  = Start date
  1.  ; GMRCDT2  = Stop date
  1.  ; GMRCSTAT = CPRS status to include in report
  1.  ; SUBTOT   = Counter for different groups
  1.  ; GMRCRPT  = 80 - 132 character report & data only output
  1.  ; GMRCBRK  = Print page break between sub-totals <Y-N>
  1.  ; GMRTST   = Includ or not include test pts Patch 1002
  1.  ; TOTCNTR  = Count for total records
  1.  I GMRCSRCH=1 D BLDPROV(.GMRCARRY)   ;BLD PROVIDER  ^TMP(GLOBAL)
  1.  I GMRCSRCH=2 D BLDLOC(.GMRCARRY)    ;BLD LOCATION  ^TMP(GLOBAL)
  1.  I GMRCSRCH=3 D BLDPROC(.GMRCARRY)   ;BLD PROCEDURE ^TMP(GLOBAL)
  1.  N TOTCNTR,SUBTOT S (SUBTOT,TOTCNTR)=0
  1.  I GMRCRPT=1 D REPORT80^GMRCPSL3(.SUBTOT,.TOTCNTR,GMRCSRCH,GMRCBRK)
  1.  I GMRCRPT=2 D REPORT32^GMRCPSL3(.SUBTOT,.TOTCNTR,GMRCSRCH,GMRCBRK)
  1.  I GMRCRPT=3 D DATAONLY^GMRCPSL4 Q
  1.  W !!,"SUB TOTAL= ",SUBTOT,!
  1.  W !,"TOTAL RECORDS= ",TOTCNTR
  1.  D ^%ZISC
  1.  K ^TMP("GMRCRPT",$J)
  1.  I ($E(IOST)="C") D
  1.  .N DIR
  1.  .S DIR(0)="E"
  1.  .W !
  1.  .D ^DIR K DIR
  1.  Q
  1.  ;
  1. BLDLOC(GMRCARRY) ; Build ^TMP were search was on location.
  1.  K ^TMP("GMRCRPT",$J)
  1.  N GMRCCNTR,LOCATION,GMRCSRT1,GMRCSRT2,GMRCLOC1,GMRCLOC2,IEN
  1.  N GMRCREM,LOCPN,CHK
  1.  S GMRCCNTR=0
  1.  ;
  1.  ; get all Locations by date range
  1.  I GMRCARRY(1)="ALL" D
  1.  .  S GMRCLOC1=GMRCDT1,GMRCLOC2=GMRCDT2,CHK=0
  1.  .  F  S GMRCLOC1=$O(^GMR(123,"E",GMRCLOC1)) Q:GMRCLOC1>GMRCLOC2  Q:GMRCLOC1=""  D
  1.  . .  S IEN=0
  1.  . .  F  S IEN=$O(^GMR(123,"E",GMRCLOC1,IEN)) Q:IEN'>0  D
  1.  . . .  ;
  1.  . . .  ; Check for Patient Location
  1.  . . .  I "LB"[GMRCARRY,$$CKSTAT(IEN,GMRCSTAT),+$P(^GMR(123,IEN,0),"^",4) D  Q
  1.  . . . .  S CHK=$$TEST(IEN,GMRTST)
  1.  . . . .  Q:+CHK
  1.  . . . .  S LOCATION=$P(^GMR(123,IEN,0),"^",4)   ; PATIENT LOCATION
  1.  . . . .  S GMRCSRT1=$$GET1^DIQ(44,LOCATION,.01)  ; PATIENT LOCATION
  1.  . . . .  S GMRCSRT2=$P(^GMR(123,IEN,0),"^",7)   ; DATE OF REQUEST
  1.  . . . .  S ^TMP("GMRCRPT",$J,GMRCSRT1,GMRCSRT2,IEN)=IEN_"|"_^GMR(123,IEN,0)
  1.  . . .  ;
  1.  . . .  ; If no patient location, check for Ordering Facility
  1.  . . .  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
  1.  . . . .  S CHK=$$TEST(IEN,GMRTST)
  1.  . . . .  Q:+CHK
  1.  . . . .  S LOCATION=$P(^GMR(123,IEN,0),"^",21)  ;ORDERING FACILITY
  1.  . . . .  S GMRCSRT1=$$GET1^DIQ(4,LOCATION,.01)  ;ORDERING FACILITY
  1.  . . . .  S GMRCSRT2=$P(^GMR(123,IEN,0),"^",7)   ;DATE OF REQUEST
  1.  . . . .  S GMRCREM=$P($G(^GMR(123,IEN,12)),"^",6)
  1.  . . . .  S ^TMP("GMRCRPT",$J,GMRCSRT1,GMRCSRT2,IEN)=IEN_"|"_^GMR(123,IEN,0)_"^"_GMRCREM
  1.  . . .  ;
  1.  . . .  ; If no patient location & NO Ordering Facility, then
  1.  . . .  ; check for Routing Facility
  1.  . . .  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
  1.  . . . .  S CHK=$$TEST(IEN,GMRTST)
  1.  . . . .  Q:+CHK
  1.  . . . .  S LOCATION=$P(^GMR(123,IEN,0),"^",23)  ;ROUTING FACILITY
  1.  . . . .  S GMRCSRT1=$$GET1^DIQ(4,LOCATION,.01)  ;ROUTING FACILITY
  1.  . . . .  S GMRCSRT2=$P(^GMR(123,IEN,0),"^",7)   ;DATE OF REQUEST
  1.  . . . .  S GMRCREM=$P($G(^GMR(123,IEN,12)),"^",6)
  1.  . . . .  S ^TMP("GMRCRPT",$J,GMRCSRT1,GMRCSRT2,IEN)=IEN_"|"_^GMR(123,IEN,0)_"^"_GMRCREM
  1.  ; Get location list from GMRCARRY and then go to global using location
  1.  I GMRCARRY(1)="ALL" Q
  1.  F  S GMRCCNTR=$O(GMRCARRY(GMRCCNTR)) Q:'GMRCCNTR  D
  1.  .  S LOCATION=$P(GMRCARRY(GMRCCNTR),"^",1)
  1.  . I "LB"[GMRCARRY,$P(GMRCARRY(GMRCCNTR),"^",3)=44 D
  1.  . .  N IEN S IEN=0
  1.  . .  F  S IEN=$O(^GMR(123,"AL",LOCATION,IEN)) Q:IEN'>0  D
  1.  . . .  I $P(^GMR(123,IEN,0),"^",7)>GMRCDT1,$P(^GMR(123,IEN,0),"^",7)<GMRCDT2,$$CKSTAT(IEN,GMRCSTAT) D
  1.  . . . . S CHK=$$TEST(IEN,GMRTST)
  1.  . . . . Q:+CHK
  1.  . . . . S GMRCSRT1=$P(GMRCARRY(GMRCCNTR),"^",2)   ; Patient Location
  1.  . . . . S GMRCSRT2=$P(^GMR(123,IEN,0),"^",7)      ; DATE OF REQUEST
  1.  . . . . S ^TMP("GMRCRPT",$J,GMRCSRT1,GMRCSRT2,IEN)=IEN_"|"_^GMR(123,IEN,0)
  1.  . I "RB"[GMRCARRY,$P(GMRCARRY(GMRCCNTR),"^",3)=4 D
  1.  . . S GMRCLOC1=GMRCDT1,GMRCLOC2=GMRCDT2
  1.  . . F  S GMRCLOC1=$O(^GMR(123,"E",GMRCLOC1)) Q:GMRCLOC1>GMRCLOC2  Q:GMRCLOC1=""  D
  1.  . . .  N IEN S IEN=0
  1.  . . .  F  S IEN=$O(^GMR(123,"E",GMRCLOC1,IEN)) Q:IEN'>0  D
  1.  . . . . I $$CKSTAT(IEN,GMRCSTAT),$P($G(^GMR(123,IEN,12)),"^",5)="F",+$P($G(^GMR(123,IEN,0)),"^",21)=LOCATION D  Q
  1.  . . . . . S CHK=$$TEST(IEN,GMRTST)
  1.  . . . . . Q:+CHK
  1.  . . . . . S GMRCSRT1=$P(GMRCARRY(GMRCCNTR),"^",2)
  1.  . . . . . S GMRCSRT2=$P(^GMR(123,IEN,0),"^",7)
  1.  . . . . . S ^TMP("GMRCRPT",$J,GMRCSRT1,GMRCSRT2,IEN)=IEN_"|"_^GMR(123,IEN,0)
  1.  . . . . 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
  1.  . . . . . S CHK=$$TEST(IEN,GMRTST)
  1.  . . . . . Q:+CHK
  1.  . . . . . S GMRCSRT1=$P(GMRCARRY(GMRCCNTR),"^",2)
  1.  . . . . . S GMRCSRT2=$P(^GMR(123,IEN,0),"^",7)
  1.  . . . . . S ^TMP("GMRCRPT",$J,GMRCSRT1,GMRCSRT2,IEN)=IEN_"|"_^GMR(123,IEN,0)
  1.  Q
  1. BLDPROC(GMRCARRY) ; Build ^TMP were search was on procedure.
  1.  K ^TMP("GMRCRPT",$J)
  1.  N GMRCCNTR,PROCEDUR,GMRCSRT1,GMRCSRT2,GMRCPRC1,GMRCPRC2,IEN,GMRCREM
  1.  S GMRCCNTR=0
  1.  ; get all Procedures by date range
  1.  I GMRCARRY(1)="ALL" D
  1.  .  S GMRCPRC1=GMRCDT1,GMRCPRC2=GMRCDT2
  1.  .  F  S GMRCPRC1=$O(^GMR(123,"E",GMRCPRC1)) Q:GMRCPRC1>GMRCPRC2  Q:GMRCPRC1=""  D
  1.  . .  S IEN=0
  1.  . .  F  S IEN=$O(^GMR(123,"E",GMRCPRC1,IEN)) Q:IEN'>0  D
  1.  . . .  I $$CKSTAT(IEN,GMRCSTAT) D        ; Ck Status
  1.  . . . .  I $P(^GMR(123,IEN,0),"^",8)>"" D              ; Ck for Proc
  1.  . . . . .  S CHK=$$TEST(IEN,GMRTST)
  1.  . . . . .  Q:+CHK
  1.  . . . . .  S PROCEDUR=$P($P(^GMR(123,IEN,0),"^",8),";",1)
  1.  . . . . .  S GMRCSRT1=$$GET1^DIQ(123.3,PROCEDUR,.01)   ;Procedure
  1.  . . . . .  S GMRCSRT2=$P(^GMR(123,IEN,0),"^",7)        ;Req Date
  1.  . . . . .  S GMRCREM=$P($G(^GMR(123,IEN,12)),"^",6)
  1.  . . . . .  S ^TMP("GMRCRPT",$J,GMRCSRT1,GMRCSRT2,IEN)=IEN_"|"_^GMR(123,IEN,0)_"^"_GMRCREM
  1.  ; Get each procedure from GMRCARRY and then go to global using procedure
  1.  I GMRCARRY(1)="ALL" Q
  1.  F  S GMRCCNTR=$O(GMRCARRY(GMRCCNTR)) Q:'GMRCCNTR  D
  1.  .  S PROCEDUR=$P(GMRCARRY(GMRCCNTR),"^",1)
  1.  .  N IEN S IEN=0
  1.  .  F  S IEN=$O(^GMR(123,"AP",PROCEDUR_";GMR(123.3,",IEN)) Q:IEN'>0  D
  1.  . .  I $P(^GMR(123,IEN,0),"^",7)>GMRCDT1,$P(^GMR(123,IEN,0),"^",7)<GMRCDT2,$$CKSTAT(IEN,GMRCSTAT) D
  1.  . . . S CHK=$$TEST(IEN,GMRTST)
  1.  . . . Q:+CHK
  1.  . . . S GMRCSRT1=$P(GMRCARRY(GMRCCNTR),"^",2)   ; PROCEDURE TYPE
  1.  . . . S GMRCSRT2=$P(^GMR(123,IEN,0),"^",7)      ; DATE OF REQUEST
  1.  . . . S GMRCREM=$P($G(^GMR(123,IEN,12)),"^",6)
  1.  . . . S ^TMP("GMRCRPT",$J,GMRCSRT1,GMRCSRT2,IEN)=IEN_"|"_^GMR(123,IEN,0)_"^"_GMRCREM
  1.  Q
  1. BLDPROV(GMRCARRY) ; Build ^TMP were search was on provider.
  1.  K ^TMP("GMRCRPT",$J)
  1.  N GMRCCNTR,PROVIDER,GMRCSRT1,GMRCSRT2,GMRCPRV1,GMRCPRV2,IEN
  1.  N GMRCPROV
  1.  S GMRCCNTR=0
  1.  ; get all providers by date range
  1.  I GMRCARRY(1)="ALL" D
  1.  .  S GMRCPRV1=GMRCDT1,GMRCPRV2=GMRCDT2
  1.  .  F  S GMRCPRV1=$O(^GMR(123,"E",GMRCPRV1)) Q:GMRCPRV1>GMRCPRV2  Q:GMRCPRV1=""  D
  1.  . .  S IEN=0
  1.  . .  F  S IEN=$O(^GMR(123,"E",GMRCPRV1,IEN)) Q:IEN'>0  D
  1.  . . .  ; Provider not null
  1.  . . .  I "LB"[GMRCARRY,$$CKSTAT(IEN,GMRCSTAT) D
  1.  . . . .  I +$P(^GMR(123,IEN,0),"^",14) D
  1.  . . . . .  S CHK=$$TEST(IEN,GMRTST)
  1.  . . . . .  Q:+CHK
  1.  . . . . .  S GMRCPROV=$P(^GMR(123,IEN,0),"^",14)      ; SENDING PROVIDER
  1.  . . . . .  S GMRCSRT1=$$GET1^DIQ(200,GMRCPROV,.01)    ; SENDING PROVIDER
  1.  . . . . .  S GMRCSRT2=$P(^GMR(123,IEN,0),"^",7)       ; DATE OF REQUEST
  1.  . . . . .  S ^TMP("GMRCRPT",$J,GMRCSRT1,GMRCSRT2,IEN)=IEN_"|"_^GMR(123,IEN,0)
  1.  . . .  ; Provider null and REMOTE ORDERING PROVIDER not
  1.  . . .  I "RB"[GMRCARRY,$$CKSTAT(IEN,GMRCSTAT) D
  1.  . . . .  I '+$P(^GMR(123,IEN,0),"^",14),$P($G(^GMR(123,IEN,12)),"^",6)'="" D
  1.  . . . . .   S CHK=$$TEST(IEN,GMRTST)
  1.  . . . . .   Q:+CHK
  1.  . . . . .   S GMRCPROV=$P($G(^GMR(123,IEN,12)),"^",6)
  1.  . . . . .   S GMRCSRT1=GMRCPROV
  1.  . . . . .   S GMRCSRT2=$P(^GMR(123,IEN,0),"^",7)       ; DATE OF REQUEST
  1.  . . . . .   S ^TMP("GMRCRPT",$J,GMRCSRT1,GMRCSRT2,IEN)=IEN_"|"_^GMR(123,IEN,0)_"^"_GMRCPROV
  1.  ; Get provider list from GMRCARRY and then go to global using provider
  1.  I GMRCARRY(1)="ALL" Q
  1.  F  S GMRCCNTR=$O(GMRCARRY(GMRCCNTR)) Q:'GMRCCNTR  D
  1.  .  S PROVIDER=$P(GMRCARRY(GMRCCNTR),"^",1)
  1.  . I "LB"[GMRCARRY,$P(GMRCARRY(GMRCCNTR),"^",3)=200 D
  1.  . .  S IEN=0
  1.  . .  F  S IEN=$O(^GMR(123,"G",PROVIDER,IEN)) Q:IEN'>0  D
  1.  . . .  I $P(^GMR(123,IEN,0),"^",7)>GMRCDT1,$P(^GMR(123,IEN,0),"^",7)<GMRCDT2,$$CKSTAT(IEN,GMRCSTAT) D
  1.  . . . . S CHK=$$TEST(IEN,GMRTST)
  1.  . . . . Q:+CHK
  1.  . . . . S GMRCSRT1=$P(GMRCARRY(GMRCCNTR),"^",2)   ; SENDING PROVIDER
  1.  . . . . S GMRCSRT2=$P(^GMR(123,IEN,0),"^",7)      ; DATE OF REQUEST
  1.  . . . . S ^TMP("GMRCRPT",$J,GMRCSRT1,GMRCSRT2,IEN)=IEN_"|"_^GMR(123,IEN,0)
  1.  . I "RB"[GMRCARRY,'$P(GMRCARRY(GMRCCNTR),"^",2) D
  1.  . . S IEN=0
  1.  . . F  S IEN=$O(^GMR(123,"AIP",PROVIDER,IEN)) Q:IEN'>0  D
  1.  . . .  I $P(^GMR(123,IEN,0),"^",7)>GMRCDT1,$P(^GMR(123,IEN,0),"^",7)<GMRCDT2,$$CKSTAT(IEN,GMRCSTAT) D
  1.  . . . . S CHK=$$TEST(IEN,GMRTST)
  1.  . . . . Q:+CHK
  1.  . . . . S GMRCSRT1=$P(GMRCARRY(GMRCCNTR),"^",1)
  1.  . . . . S GMRCSRT2=$P(^GMR(123,IEN,0),"^",7)
  1.  . . . . S ^TMP("GMRCRPT",$J,GMRCSRT1,GMRCSRT2,IEN)=IEN_"|"_^GMR(123,IEN,0)_"^"_PROVIDER
  1.  Q
  1. CKSTAT(IEN,GMRCSTAT) ; Does entry have selected status
  1.  ; Input:
  1.  ;  IEN      = File #123 IEN
  1.  ;  GMRCSTAT = Selected status(es)
  1.  ; Output:
  1.  ;  GMRCKS   = Result (1:yes; 0:no)
  1.  N GMRCKS,GMRCS,LOOP,STATUS
  1.  S GMRCKS=0
  1.  S GMRCS=+$P(^GMR(123,IEN,0),"^",12)
  1.  F LOOP=1:1:$L(GMRCSTAT,",") S STATUS=$P(GMRCSTAT,",",LOOP) Q:GMRCKS  D
  1.  . I STATUS=GMRCS S GMRCKS=1
  1.  Q GMRCKS
  1. TEST(IEN,TST) ;Check to see if this consult shold be included
  1.  N RESULT,NODE,SSN
  1.  S RESULT=0
  1.  S NODE=^GMR(123,IEN,0)
  1.  S SSN=$E($P(^DPT($P(NODE,"^",2),0),"^",9),1,5)
  1.  I SSN="00000"&(GMRTST="E") S RESULT=1
  1.  I SSN'="00000"&(GMRTST="D") S RESULT=1
  1.  Q RESULT