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

GMRCSTL2.m

Go to the documentation of this file.
  1. GMRCSTL2 ;SLC/DCM,dee;MA - List Manager Format Routine - Get Active Consults by service - pending,active,scheduled,incomplete,etc. ;4/18/01 10:31
  1. ;;3.0;CONSULT/REQUEST TRACKING;**7,21,22,63**;DEC 27, 1997;Build 10
  1. ; Patch #21 changed array GMRCTOT to ^TMP("GMRCTOT",$J)
  1. ; Patch #21 also added a plus sign to the $P when setting
  1. ; GMRCDLA to check for a NULL value.
  1. ; This routine invokes IA #10035,#44, #10040
  1. Q
  1. ;
  1. ONESTAT(GMRCARRN) ;Process one status
  1. ; Input -- GMRCARRN List Template Array Name (Subscript)
  1. ; Values:
  1. ; "CP": pending consults; "IFC": inter-facility consults
  1. ; Output - None
  1. S ^TMP("GMRCTOT",$J,1,GMRCSVC,STATUS)=0
  1. S ^TMP("GMRCTOT",$J,2,GMRCSVC,STATUS)=0
  1. S GMRCXDT=$S(GMRCDT1="ALL":0,1:9999999-GMRCDT2-.6)
  1. F S GMRCXDT=$O(^GMR(123,"AE",GMRCSVC,STATUS,GMRCXDT)) Q:GMRCXDT=""!(GMRCXDT>(9999999-GMRCDT1)) D
  1. .S GMRCPT=0
  1. ONE .;Loop for one consult at a time
  1. .F S GMRCPT=$O(^GMR(123,"AE",GMRCSVC,STATUS,GMRCXDT,GMRCPT)) Q:GMRCPT="" D
  1. ..; Check for bad "AE" x-ref
  1. ..I '$D(^GMR(123,GMRCPT,0)) D Q
  1. ...K ^GMR(123,"AE",GMRCSVC,STATUS,GMRCXDT,GMRCPT)
  1. ..S X=9999999-GMRCXDT
  1. ..D REGDTM^GMRCU
  1. ..S GMRCDT=$P(X," ",1)
  1. ..S GMRCDLA=$P(X," ",1)
  1. ..S GMRCD(0)=^GMR(123,GMRCPT,0)
  1. ..I GMRCARRN="IFC" D Q:'GMRCCK
  1. ...S GMRCCK=1
  1. ...S:'$D(GMRCIS) GMRCCK=0 S:'$P($G(GMRCD(0)),"^",23) GMRCCK=0
  1. ...I GMRCCK=1 D
  1. ....S GMRCD(12)=$G(^GMR(123,GMRCPT,12))
  1. ....I GMRCIS="R",$P(GMRCD(12),"^",5)'="P" S GMRCCK=0
  1. ....I GMRCIS="C",$P(GMRCD(12),"^",5)'="F" S GMRCCK=0
  1. ....I $D(GMRCREMP),$P(GMRCD(12),"^",6)'=GMRCREMP S GMRCCK=0
  1. ....I $D(GMRCRF),$P($G(GMRCD(0)),"^",23)'=GMRCRF S GMRCCK=0
  1. ..S GMRCPTN=$P(^DPT($P(GMRCD(0),"^",2),0),"^",1)
  1. ..S GMRCPTN=$P(GMRCPTN,",",1)_","_$E($P(GMRCPTN,",",2),1)_"."
  1. ..S GMRCPTSN="("_$E($P(^DPT($P(GMRCD(0),"^",2),0),"^",9),6,9)_")"
  1. ..; IF Consults
  1. ..I GMRCARRN="IFC" D
  1. ...N GMRCIRF,RCVDT,COMPLDT,ND
  1. ...S GMRCIRFN="NONE",GMRCIDD="N/A",GMRCRDT=""
  1. ...S GMRCIRF=$P($G(GMRCD(0)),"^",23)
  1. ... I GMRCIRF S GMRCIRFN=$E($$GET1^DIQ(4,GMRCIRF,.01),1,16)
  1. ...I '$D(^TMP("GMRCTOT",$J,1,GMRCSVC,"F",GMRCIRFN)) D
  1. ....S ^TMP("GMRCTOT",$J,1,GMRCSVC,"F",GMRCIRFN)=0
  1. ....S GMRCST(1,GMRCSVC,GMRCIRFN)="0^0"
  1. ...D GETDT^GMRCSTU(GMRCPT)
  1. ...I COMPLDT<9999999,$S(GMRCDT1="ALL":1,RCVDT'<GMRCDT1&(RCVDT'>GMRCDT2):1,1:0) D
  1. ....S X1=COMPLDT,X2=RCVDT D ^%DTC
  1. ....S GMRCIDD=X
  1. ...I GMRCIS="C" D
  1. ....S GMRCRDT=$$GETRDT(GMRCPT)
  1. ....I GMRCRDT]"" D
  1. .....N X
  1. .....S X=GMRCRDT D REGDT^GMRCU
  1. .....S GMRCRDT=X
  1. ..S GMRCD=0
  1. ..S GMRCD=$O(^GMR(123,GMRCPT,40,"B",GMRCD))
  1. ..I GMRCD]"" D
  1. ...S GMRCDA=""
  1. ...S GMRCDA=$O(^GMR(123,+GMRCPT,40,"B",GMRCD,GMRCDA))
  1. ..S GMRCDLA=$E($P($G(^GMR(123.1,+$P(GMRCD(0),"^",13),0)),"^"),1,19)
  1. ..S GMRCLOC=$P(GMRCD(0),"^",4)
  1. ..S:$L(GMRCLOC) GMRCLOC=$P($G(^SC(GMRCLOC,0)),"^",1) ;DBIA#10040
  1. ..I '$L(GMRCLOC),$P(GMRCD(0),U,21) D
  1. ...S GMRCLOC=$$GET1^DIQ(4,$P(GMRCD(0),U,21),.01)
  1. ..I '$L(GMRCLOC),$P(GMRCD(0),U,23) D
  1. ...S GMRCLOC=$$GET1^DIQ(4,$P(GMRCD(0),U,23),.01)
  1. ..I GMRCARRN="IFC",$L(GMRCLOC) D
  1. ...S GMRCLOC=$E(GMRCLOC,1,23)
  1. ..I ^TMP("GMRCTOT",$J,1,GMRCSVC,"T")=0 D
  1. ...S GMRCCT=GMRCCT+1
  1. ...S ^TMP("GMRCR",$J,GMRCARRN,GMRCCT,0)=CTRLTEMP
  1. ...S GMRCCT=GMRCCT+1
  1. ...S TEMP="SERVICE: "_GMRCSVCP
  1. ...S:GMRCSVCG>0 TEMP=TEMP_" in Group: "_$P(^GMR(123.5,GMRCSVCG,0),"^",1)
  1. ...S ^TMP("GMRCR",$J,GMRCARRN,GMRCCT,0)=CTRLTEMP_TEMP
  1. ...S NUMCLIN=NUMCLIN+1
  1. ..S LINETEMP=""
  1. CTRL ..I GMRCCTRL#100\10 D
  1. ...I GMRCCTRL#100\10=1 D
  1. ....S GMRCLINE=GMRCLINE+1
  1. ....S ^TMP("GMRCRINDEX",$J,GMRCLINE)=GMRCPT
  1. ....S LINETEMP=$J(GMRCLINE,4)_" "
  1. ...E S LINETEMP=$J(GMRCPT,9)_" "
  1. ..I GMRCCTRL#2 S LINETEMP=GMRCPT_"^"_LINETEMP
  1. ..I GMRCCTRL#1000\100 D
  1. ...S STS=$$STATABBR^GMRCSTL1(STATUS)
  1. ...S STS=STS_$J("",4-$L(STS)+1)
  1. ..E D
  1. ...S STS=$$STATNAME^GMRCSTL1(STATUS)
  1. ...S STS=STS_$J("",10-$L(STS)+1)
  1. ..S GMRCCT=GMRCCT+1
  1. ..S ^TMP("GMRCR",$J,GMRCARRN,GMRCCT,0)=LINETEMP_STS_GMRCDLA_$J("",20-$L(GMRCDLA))_GMRCDT_" "_GMRCPTN_" "_GMRCPTSN_$J("",12-$L(GMRCPTN)+5)_GMRCLOC
  1. ..; IF Consults
  1. ..I GMRCARRN="IFC" D
  1. ...S ^TMP("GMRCR",$J,GMRCARRN,GMRCCT,0)=^TMP("GMRCR",$J,GMRCARRN,GMRCCT,0)_$J("",25-$L(GMRCLOC))_GMRCIRFN_$J("",17-$L(GMRCIRFN))_" "_GMRCIDD_$J("",9-$L(GMRCIDD))_" "_GMRCRDT
  1. ...I '$D(GMRCCNSLT(GMRCPT)) S ^TMP("GMRCTOT",$J,1,GMRCSVC,"F",GMRCIRFN)=^TMP("GMRCTOT",$J,1,GMRCSVC,"F",GMRCIRFN)+1,GMRCCNSLT(GMRCPT)=""
  1. ...I GMRCIDD'="N/A" D
  1. ....S $P(GMRCST(1,GMRCSVC,GMRCIRFN),"^")=$P(GMRCST(1,GMRCSVC,GMRCIRFN),"^")+GMRCIDD
  1. ....S $P(GMRCST(1,GMRCSVC,GMRCIRFN),"^",2)=$P(GMRCST(1,GMRCSVC,GMRCIRFN),"^",2)+1
  1. ....S $P(GMRCST(1,GMRCSVC),"^")=$P(GMRCST(1,GMRCSVC),"^")+GMRCIDD
  1. ....S $P(GMRCST(1,GMRCSVC),"^",2)=$P(GMRCST(1,GMRCSVC),"^",2)+1
  1. ..;
  1. ADDTOT ..;Add to totals
  1. ..; for all status for this service
  1. ..S ^TMP("GMRCTOT",$J,1,GMRCSVC,"T")=^TMP("GMRCTOT",$J,1,GMRCSVC,"T")+1
  1. ..; pending for this service
  1. ..S:",3,4,5,6,8,9,11,99,"[(","_STATUS_",") ^TMP("GMRCTOT",$J,1,GMRCSVC,"P")=^TMP("GMRCTOT",$J,1,GMRCSVC,"P")+1
  1. ..; this status (STATUS) for this service
  1. ..S ^TMP("GMRCTOT",$J,1,GMRCSVC,STATUS)=^TMP("GMRCTOT",$J,1,GMRCSVC,STATUS)+1
  1. ..; this status (STATUS) for services to all of its groupers
  1. F GRP=GROUPER:-1:1 D
  1. . I $D(^TMP("GMRCTOTX",$J,GROUPER(GRP),GMRCSVC,STATUS)) Q
  1. . S ^TMP("GMRCTOT",$J,2,GROUPER(GRP),STATUS)=$G(^TMP("GMRCTOT",$J,2,GROUPER(GRP),STATUS))+^TMP("GMRCTOT",$J,1,GMRCSVC,STATUS),^TMP("GMRCTOTX",$J,GROUPER(GRP),GMRCSVC,STATUS)=""
  1. Q
  1. ;
  1. GETRDT(GMRCPT) ;get the received date
  1. ; Input:
  1. ; GMRCPT = File #123 IEN
  1. ; Output:
  1. ; GMRCRDT = Date of action entry for remote request received/received
  1. N GMRCCKR,GMRCRDT,ND
  1. S (GMRCCKR,ND)=0,GMRCRDT=""
  1. F S ND=$O(^GMR(123,GMRCPT,40,ND)) Q:ND'>0!GMRCCKR D
  1. .I $P(^GMR(123,GMRCPT,40,ND,0),"^",2)=23 D
  1. ..S GMRCRDT=$P(^GMR(123,GMRCPT,40,ND,0),"^"),GMRCCKR=1
  1. .I $P(^GMR(123,GMRCPT,40,ND,0),"^",2)=21 D
  1. ..S GMRCRDT=$P(^GMR(123,GMRCPT,40,ND,0),"^")
  1. Q GMRCRDT