- GMRCSLM1 ;SLC/DCM - Gather data and format ^TMP global for consult tracking Silent call for use by List Manager and GUI ;10/9/01 23:12
- ;;3.0;CONSULT/REQUEST TRACKING;**1,4,10,12,15,17,22,32,63**;DEC 27, 1997;Build 10
- ;
- ; This routine invokes IA #2638,#2740
- ;
- G AD
- SVC(NODE) ;Check for a valid service
- K GMRCDEAV
- I '$D(^GMR(123,NODE,0)) Q 0
- I '+$P(^GMR(123,NODE,0),"^",5) Q 0
- I '$D(^TMP("GMRCS",$J,$P(^GMR(123,NODE,0),"^",5))) Q 0
- Q 1
- AD ;Main entry point. Loop through AD x-ref in file 123; Find consults that have been released to requested service
- ;;DFN and GMRCSSNM must be defined when this entry point is called
- ;;DFN=Internal File Number of Patient in ^DPT
- ;;GMRCSSNM=Service Name of a Hospital Service from file ^GMR(123.5
- ;;If GMRCSSNM is not defined or is null, then no records will be found.
- ;;GMRCOER must be passed so that proper formatting for GUI or List Manager can be performed. GMRCOER is passed as 0 for List Manager, 1 for GUI.
- ;;GMRCDT1 and GMRCDT2 are passed in as start and stop dates for the lookup. If GMRCDT1="" or GMRCDT1="ALL", then all dates are searched.
- ;;GMRCIS=IFC site (if defined); Values: R(equesting) or C(onsulting)
- ;; ***********************************************************
- K ^TMP("GMRCR",$J,"CS"),GMRCNUL
- I $D(GMRCSSS) S (GMRCDG,GMRCSS)=GMRCSSS,GMRCSSNM=($P($G(^GMR(123.5,+GMRCSS,0)),"^",1)) D SERV1^GMRCASV K GMRCSSS ;reset after forward
- S TAB="",$P(TAB," ",41)="",BLK=0,LNCT=1 S:'$D(GMRCOER) GMRCOER=0
- S GMRCD=0 F S GMRCD=$O(^GMR(123,"AD",DFN,GMRCD)) Q:'GMRCD S GMRCDA=0 F S GMRCDA=$O(^GMR(123,"AD",DFN,GMRCD,GMRCDA)) Q:'GMRCDA I $$SVC(GMRCDA) D SET
- D END Q
- SET ;;Format entries into a word processing 'TMP("GMRCR",$J,"CS",' global that List Manager can display
- ;;GMRCOER is a variable that signals that data is being formatted for the OE/RR GUI; this data is formatted differently than the data for List Manager.
- ;;GMRCOER=0 : Data is List Manager formatted.
- ;;GMRCOER=1 : Data is OE/RR GUI formatted.
- S:'$D(TAB) TAB="",$P(TAB," ",30)=""
- S GMRCIFN=$G(GMRCDA) I '$L(GMRCIFN),$D(XQADATA) S (GMRCDA,GMRCIFN)=+XQADATA
- I $G(XQADATA)["@" S (GMRCDA,GMRCIFN)=+$P($P(XQADATA,"@",2),"|",2)
- S GMRCSEX=$S($P(^DPT(DFN,0),"^",2)="M":"MALE",1:"FEMALE")
- I '$D(^GMR(123,+GMRCIFN,0)) S GMRCQUT=1 Q
- S PROC="",GMRC(0)=^GMR(123,GMRCIFN,0)
- ;IF Consults
- N GMRCCK
- I $D(GMRCIS) D Q:'GMRCCK
- . S GMRCCK=1
- . S:'$P($G(GMRC(0)),"^",23) GMRCCK=0
- . I GMRCCK=1 D
- . . S GMRC(12)=$G(^GMR(123,GMRCIFN,12))
- . . I GMRCIS="R",$P(GMRC(12),"^",5)'="P" S GMRCCK=0
- . . I GMRCIS="C",$P(GMRC(12),"^",5)'="F" S GMRCCK=0
- I $D(GMRCSTCK),GMRCSTCK'="" N STATUS,TITLE D Q:'STATUS
- . N I
- . F I=1:1 S STATUS=$P(GMRCSTCK,",",I) Q:STATUS=$P(GMRC(0),"^",12) Q:'STATUS
- . Q
- I $D(GMRCVP),GMRCVP'=$P(GMRC(0),"^",8) Q
- S (GMRCFMDT,X)=$P(GMRC(0),"^",7) I GMRCDT1'="ALL",$P(X,".",1)<GMRCDT1!($P(X,".",1)>GMRCDT2) Q
- I GMRCOER'=2 D
- . S BLK=BLK+1
- . S ^TMP("GMRCR",$J,"CS","AD",BLK,LNCT,GMRCDA)=""
- D REGDTM^GMRCU S CDT=$P(X," ")
- S PROC=$S($P(GMRC(0),U,17)="P":"Procedure",1:"Consult")
- I PROC'="Consult" S PROC=$$GET1^DIQ(123.3,+$P(GMRC(0),"^",8),.01)
- S:PROC="" PROC="Consult"
- S TO=+$P(GMRC(0),"^",5)
- I +TO S TOD=$S($P($G(^GMR(123.5,+TO,0)),"^",2)=9:1,1:0)
- I '$D(TOD) S TOD=0
- S TO=$S(+TO:$P($G(^GMR(123.5,+TO,0)),"^",1),1:"")
- S TO=$S(TOD:"<",1:"")_TO
- S TO=$S(GMRCOER:TO,1:$E(TO,1,40))_$S(TOD:">",1:"")
- I '$L(TO) S TO="**Unknown Service**"
- S STS=$P(GMRC(0),"^",12) D
- . I '+STS,'$D(^ORD(100.01,+STS,0)) Q
- . I '+GMRCOER S STS=$P(^ORD(100.01,+STS,.1),"^",1) Q
- . I GMRCOER=1 S STS=$P(^ORD(100.01,+STS,0),"^") Q
- . S STS=$P(^ORD(100.01,+STS,.1),"^")
- I $S(STS="":1,'$D(^ORD(100.01,+$P(GMRC(0),"^",12),0)):1,1:0) S STS=99,$P(GMRC(0),"^",12)=STS,STS=$S(GMRCOER=1:$P(^ORD(100.01,5,0),"^",1),1:$P(^ORD(100.01,+STS,.1),"^",1))
- D SERVPROC
- I 'GMRCOER D Q
- . S ^TMP("GMRCR",$J,"CS",LNCT,0)=BLK_$E(TAB,1,(4-$L(BLK)))_CDT_" "_$E(STS,1,3)_$S(STS?1A:" ",STS?2A:" ",1:"")_" "_$J(GMRCDA,7)_" "_$S($P(GMRC(0),"^",19)="Y":"*",1:" ")_TITLE
- . S LNCT=LNCT+1
- I GMRCOER D
- . N DATA
- . S DATA=GMRCDA_U_GMRCFMDT_U_STS_U_TO_U_PROC_U
- . S DATA=DATA_$S($P(GMRC(0),U,19)="Y":"*",1:"")_U
- . S DATA=DATA_TITLE_U_$P(GMRC(0),U,3)
- . D ;get type of record for proper icon in GUI
- .. ; "C"=reg cons, "P"=reg proc, "M"=clin proc, "I"=IF cons, "R"=IF proc
- .. I +$G(^GMR(123,GMRCDA,1)) S $P(DATA,U,9)="M" Q
- .. S $P(DATA,U,9)=$P(GMRC(0),U,17)
- .. N GMRCGVER
- .. S GMRCGVER=$P($G(ORWCLVER),".",3,4) ;GUI version running
- .. I GMRCGVER'>19.1 Q ;will crash at less than 19.1
- .. I $P(GMRC(0),U,23) S $P(DATA,U,9)=$S($P(DATA,U,9)="P":"R",1:"I")
- . S ^TMP("GMRCR",$J,"CS",LNCT,0)=DATA
- . S LNCT=LNCT+1
- . K STSOER Q
- Q
- END I LNCT<2 S (BLK,LNCT,GMRCNUL)=1,GMRCNPM="< PATIENT DOES NOT HAVE ANY CONSULTS/REQUESTS "_$S($D(GMRCPRNM):"FOR "_GMRCPRNM,1:"")_" ON FILE. >",GMRCNPM=$E(TAB,1,(80-$L(GMRCNPM))\80)_GMRCNPM,^TMP("GMRCR",$J,"CS",LNCT,0)=GMRCNPM D
- .I $D(GMRCDT1)&($D(GMRCDT2)),GMRCDT1'="ALL" S LNCT=LNCT+1,^TMP("GMRCR",$J,"CS",LNCT,0)="Between Dates: "_$$FMTE^XLFDT(GMRCDT1)_" and "_$$FMTE^XLFDT(GMRCDT2)
- .I $D(GMRCSTCK),$L(GMRCSTCK) S LNCT=LNCT+1,^TMP("GMRCR",$J,"CS",LNCT,0)="With Status: " S STS="" F I=1:1 S STS=$P(GMRCSTCK,",",I) Q:STS="" S ^TMP("GMRCR",$J,"CS",LNCT,0)=^(0)_$P($G(^ORD(100.01,+STS,0)),"^",1)_" "
- .Q
- E S (BLK,LNCT)=LNCT-1,^TMP("GMRCR",$J,"CS",0)="^^^"_LNCT
- I $D(GMRCALFL) S (BLK,LNCT)=1
- K TO,TOD,END,FLG,GMRC(0),GMRCD,GMRCDG,GMRCIFN,GMRCFMDT,GMRCNPM,GMRCWARD
- K I,PROC,STS,URG
- Q
- OER(DFN,GMRCDG,GMRCDT1,GMRCDT2,GMRCSTCK,GMRCOER) ;;GUI interface for CPRS
- ;;DFN=Patient internal file number
- ;;GMRCDG: Internal file number of consult service from file 123.5
- ;;GMRCDT1: Beginning date for lookup
- ;;GMRCDT2: Ending date for lookup
- ;;GMRCSTCK: IEN from OER Status File [^OER(100.01)] to screen results
- ;; so that only consults with a desired status are displayed
- ;; Can be sent as a set of statuses: i.e., 6,5,2
- ;; (GMRCSTCK=GMRC STATUS CHECK)
- ;;GMRCOER=0 if request is from CONSULTS
- ;; =1 if request is for CPRS List Manager
- ;; =2 if for CPRS GUI
- I GMRCDT1="" S GMRCDT1="ALL"
- I GMRCDG="" S GMRCDG=$O(^GMR(123.5,"B","ALL SERVICES",0))
- S:'$D(GMRCOER) GMRCOER=1
- D SERV1^GMRCASV,AD
- K ^TMP("GMRCS",$J),^TMP("GMRCSLIST",$J)
- Q
- SERVPROC ; Build contents of SERV/PROC field for List Manager
- N TYPE,OTXT
- S TITLE=""
- S TYPE=""
- S OTXT=$P($G(^GMR(123,GMRCDA,1.11)),"^")
- I OTXT="" D BUILD2
- I OTXT'="" D BUILD1
- Q
- BUILD1 ;OTXT does contain information
- N FLG,BADFLG,TPROC,TTO,LEN,ABBRS,ABBRP
- S TPROC=$$UP^XLFSTR(PROC),TTO=$$UP^XLFSTR(TO)
- S TITLE=OTXT,OTXT=$$UP^XLFSTR(OTXT)
- S BADFLG=0
- I PROC="Consult" S FLG=1,TYPE="Cons"
- I PROC'="Consult" S FLG=0,TYPE="Proc"
- S LEN=$L(TITLE)
- I TO="" S TO="No Service"
- I LEN<30,FLG=1,OTXT'=TTO S TITLE=TITLE_" "_TO_" "_TYPE Q
- I LEN<30,FLG=1,OTXT=TTO S TITLE=TITLE_" "_TYPE Q
- I TO["<" S BADFLG=1
- S ABBRS=$$SVC^GMRCAU(GMRCDA),ABBRP=$$PROC^GMRCAU(GMRCDA)
- I LEN<30,FLG=0,TPROC'=OTXT,TTO'=TPROC S TITLE=TITLE_" "_PROC_" "_TO_" "_TYPE Q
- I LEN<30,FLG=0,TPROC=OTXT,TTO'=TPROC S TITLE=TITLE_" "_TO_" "_TYPE Q
- I LEN<30,FLG=0,TPROC=OTXT,TTO=TPROC S TITLE=TITLE_" "_TYPE Q
- I LEN>30,FLG=1,TTO'=OTXT S TITLE=TITLE_" "_TO_" "_TYPE Q
- I LEN>30,FLG=1,TTO=OTXT S TITLE=TITLE_" "_TYPE Q
- I LEN>30,FLG=0,TPROC'=OTXT,TTO'=TPROC S TITLE=TITLE_" "_ABBRP_" "_TYPE Q
- I LEN>30,FLG=0,TTO'=OTXT,BADFLG=0 S TITLE=TITLE_" "_ABBRS_" "_TYPE Q
- I LEN>30,FLG=0,TTO'=OTXT,BADFLG=1 S TITLE=TITLE_" "_"<"_ABBRS_">"_TYPE Q
- Q
- BUILD2 ;OTXT contains no information
- N FLG,TPROC,TTO,LEN
- S TPROC=$$UP^XLFSTR(PROC),TTO=$$UP^XLFSTR(TO)
- I PROC="Consult" S TITLE=TO,LEN=$L(TITLE),FLG=1,TYPE="Cons"
- I PROC'="Consult" S TITLE=PROC,LEN=$L(TITLE),FLG=0,TYPE="Proc"
- I FLG=1 S TITLE=TITLE_" "_TYPE Q
- I FLG=0,TTO=TPROC S TITLE=TITLE_" "_TYPE Q
- I FLG=0,TTO'=TPROC S TITLE=TITLE_" "_TO_" "_TYPE Q
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRCSLM1 7931 printed Jan 18, 2025@02:48:23 Page 2
- GMRCSLM1 ;SLC/DCM - Gather data and format ^TMP global for consult tracking Silent call for use by List Manager and GUI ;10/9/01 23:12
- +1 ;;3.0;CONSULT/REQUEST TRACKING;**1,4,10,12,15,17,22,32,63**;DEC 27, 1997;Build 10
- +2 ;
- +3 ; This routine invokes IA #2638,#2740
- +4 ;
- +5 GOTO AD
- SVC(NODE) ;Check for a valid service
- +1 KILL GMRCDEAV
- +2 IF '$DATA(^GMR(123,NODE,0))
- QUIT 0
- +3 IF '+$PIECE(^GMR(123,NODE,0),"^",5)
- QUIT 0
- +4 IF '$DATA(^TMP("GMRCS",$JOB,$PIECE(^GMR(123,NODE,0),"^",5)))
- QUIT 0
- +5 QUIT 1
- AD ;Main entry point. Loop through AD x-ref in file 123; Find consults that have been released to requested service
- +1 ;;DFN and GMRCSSNM must be defined when this entry point is called
- +2 ;;DFN=Internal File Number of Patient in ^DPT
- +3 ;;GMRCSSNM=Service Name of a Hospital Service from file ^GMR(123.5
- +4 ;;If GMRCSSNM is not defined or is null, then no records will be found.
- +5 ;;GMRCOER must be passed so that proper formatting for GUI or List Manager can be performed. GMRCOER is passed as 0 for List Manager, 1 for GUI.
- +6 ;;GMRCDT1 and GMRCDT2 are passed in as start and stop dates for the lookup. If GMRCDT1="" or GMRCDT1="ALL", then all dates are searched.
- +7 ;;GMRCIS=IFC site (if defined); Values: R(equesting) or C(onsulting)
- +8 ;; ***********************************************************
- +9 KILL ^TMP("GMRCR",$JOB,"CS"),GMRCNUL
- +10 ;reset after forward
- IF $DATA(GMRCSSS)
- SET (GMRCDG,GMRCSS)=GMRCSSS
- SET GMRCSSNM=($PIECE($GET(^GMR(123.5,+GMRCSS,0)),"^",1))
- DO SERV1^GMRCASV
- KILL GMRCSSS
- +11 SET TAB=""
- SET $PIECE(TAB," ",41)=""
- SET BLK=0
- SET LNCT=1
- if '$DATA(GMRCOER)
- SET GMRCOER=0
- +12 SET GMRCD=0
- FOR
- SET GMRCD=$ORDER(^GMR(123,"AD",DFN,GMRCD))
- if 'GMRCD
- QUIT
- SET GMRCDA=0
- FOR
- SET GMRCDA=$ORDER(^GMR(123,"AD",DFN,GMRCD,GMRCDA))
- if 'GMRCDA
- QUIT
- IF $$SVC(GMRCDA)
- DO SET
- +13 DO END
- QUIT
- SET ;;Format entries into a word processing 'TMP("GMRCR",$J,"CS",' global that List Manager can display
- +1 ;;GMRCOER is a variable that signals that data is being formatted for the OE/RR GUI; this data is formatted differently than the data for List Manager.
- +2 ;;GMRCOER=0 : Data is List Manager formatted.
- +3 ;;GMRCOER=1 : Data is OE/RR GUI formatted.
- +4 if '$DATA(TAB)
- SET TAB=""
- SET $PIECE(TAB," ",30)=""
- +5 SET GMRCIFN=$GET(GMRCDA)
- IF '$LENGTH(GMRCIFN)
- IF $DATA(XQADATA)
- SET (GMRCDA,GMRCIFN)=+XQADATA
- +6 IF $GET(XQADATA)["@"
- SET (GMRCDA,GMRCIFN)=+$PIECE($PIECE(XQADATA,"@",2),"|",2)
- +7 SET GMRCSEX=$SELECT($PIECE(^DPT(DFN,0),"^",2)="M":"MALE",1:"FEMALE")
- +8 IF '$DATA(^GMR(123,+GMRCIFN,0))
- SET GMRCQUT=1
- QUIT
- +9 SET PROC=""
- SET GMRC(0)=^GMR(123,GMRCIFN,0)
- +10 ;IF Consults
- +11 NEW GMRCCK
- +12 IF $DATA(GMRCIS)
- Begin DoDot:1
- +13 SET GMRCCK=1
- +14 if '$PIECE($GET(GMRC(0)),"^",23)
- SET GMRCCK=0
- +15 IF GMRCCK=1
- Begin DoDot:2
- +16 SET GMRC(12)=$GET(^GMR(123,GMRCIFN,12))
- +17 IF GMRCIS="R"
- IF $PIECE(GMRC(12),"^",5)'="P"
- SET GMRCCK=0
- +18 IF GMRCIS="C"
- IF $PIECE(GMRC(12),"^",5)'="F"
- SET GMRCCK=0
- End DoDot:2
- End DoDot:1
- if 'GMRCCK
- QUIT
- +19 IF $DATA(GMRCSTCK)
- IF GMRCSTCK'=""
- NEW STATUS,TITLE
- Begin DoDot:1
- +20 NEW I
- +21 FOR I=1:1
- SET STATUS=$PIECE(GMRCSTCK,",",I)
- if STATUS=$PIECE(GMRC(0),"^",12)
- QUIT
- if 'STATUS
- QUIT
- +22 QUIT
- End DoDot:1
- if 'STATUS
- QUIT
- +23 IF $DATA(GMRCVP)
- IF GMRCVP'=$PIECE(GMRC(0),"^",8)
- QUIT
- +24 SET (GMRCFMDT,X)=$PIECE(GMRC(0),"^",7)
- IF GMRCDT1'="ALL"
- IF $PIECE(X,".",1)<GMRCDT1!($PIECE(X,".",1)>GMRCDT2)
- QUIT
- +25 IF GMRCOER'=2
- Begin DoDot:1
- +26 SET BLK=BLK+1
- +27 SET ^TMP("GMRCR",$JOB,"CS","AD",BLK,LNCT,GMRCDA)=""
- End DoDot:1
- +28 DO REGDTM^GMRCU
- SET CDT=$PIECE(X," ")
- +29 SET PROC=$SELECT($PIECE(GMRC(0),U,17)="P":"Procedure",1:"Consult")
- +30 IF PROC'="Consult"
- SET PROC=$$GET1^DIQ(123.3,+$PIECE(GMRC(0),"^",8),.01)
- +31 if PROC=""
- SET PROC="Consult"
- +32 SET TO=+$PIECE(GMRC(0),"^",5)
- +33 IF +TO
- SET TOD=$SELECT($PIECE($GET(^GMR(123.5,+TO,0)),"^",2)=9:1,1:0)
- +34 IF '$DATA(TOD)
- SET TOD=0
- +35 SET TO=$SELECT(+TO:$PIECE($GET(^GMR(123.5,+TO,0)),"^",1),1:"")
- +36 SET TO=$SELECT(TOD:"<",1:"")_TO
- +37 SET TO=$SELECT(GMRCOER:TO,1:$EXTRACT(TO,1,40))_$SELECT(TOD:">",1:"")
- +38 IF '$LENGTH(TO)
- SET TO="**Unknown Service**"
- +39 SET STS=$PIECE(GMRC(0),"^",12)
- Begin DoDot:1
- +40 IF '+STS
- IF '$DATA(^ORD(100.01,+STS,0))
- QUIT
- +41 IF '+GMRCOER
- SET STS=$PIECE(^ORD(100.01,+STS,.1),"^",1)
- QUIT
- +42 IF GMRCOER=1
- SET STS=$PIECE(^ORD(100.01,+STS,0),"^")
- QUIT
- +43 SET STS=$PIECE(^ORD(100.01,+STS,.1),"^")
- End DoDot:1
- +44 IF $SELECT(STS="":1,'$DATA(^ORD(100.01,+$PIECE(GMRC(0),"^",12),0)):1,1:0)
- SET STS=99
- SET $PIECE(GMRC(0),"^",12)=STS
- SET STS=$SELECT(GMRCOER=1:$PIECE(^ORD(100.01,5,0),"^",1),1:$PIECE(^ORD(100.01,+STS,.1),"^",1))
- +45 DO SERVPROC
- +46 IF 'GMRCOER
- Begin DoDot:1
- +47 SET ^TMP("GMRCR",$JOB,"CS",LNCT,0)=BLK_$EXTRACT(TAB,1,(4-$LENGTH(BLK)))_CDT_" "_$EXTRACT(STS,1,3)_$SELECT(STS?1A:" ",STS?2A:" ",1:"")_" "_$JUSTIFY(GMRCDA,7)_" "_$SELECT($PIECE(GMRC(0),"^",19)="Y":"*",1:" ")_TITLE
- +48 SET LNCT=LNCT+1
- End DoDot:1
- QUIT
- +49 IF GMRCOER
- Begin DoDot:1
- +50 NEW DATA
- +51 SET DATA=GMRCDA_U_GMRCFMDT_U_STS_U_TO_U_PROC_U
- +52 SET DATA=DATA_$SELECT($PIECE(GMRC(0),U,19)="Y":"*",1:"")_U
- +53 SET DATA=DATA_TITLE_U_$PIECE(GMRC(0),U,3)
- +54 ;get type of record for proper icon in GUI
- Begin DoDot:2
- +55 ; "C"=reg cons, "P"=reg proc, "M"=clin proc, "I"=IF cons, "R"=IF proc
- +56 IF +$GET(^GMR(123,GMRCDA,1))
- SET $PIECE(DATA,U,9)="M"
- QUIT
- +57 SET $PIECE(DATA,U,9)=$PIECE(GMRC(0),U,17)
- +58 NEW GMRCGVER
- +59 ;GUI version running
- SET GMRCGVER=$PIECE($GET(ORWCLVER),".",3,4)
- +60 ;will crash at less than 19.1
- IF GMRCGVER'>19.1
- QUIT
- +61 IF $PIECE(GMRC(0),U,23)
- SET $PIECE(DATA,U,9)=$SELECT($PIECE(DATA,U,9)="P":"R",1:"I")
- End DoDot:2
- +62 SET ^TMP("GMRCR",$JOB,"CS",LNCT,0)=DATA
- +63 SET LNCT=LNCT+1
- +64 KILL STSOER
- QUIT
- End DoDot:1
- +65 QUIT
- END IF LNCT<2
- SET (BLK,LNCT,GMRCNUL)=1
- SET GMRCNPM="< PATIENT DOES NOT HAVE ANY CONSULTS/REQUESTS "_$SELECT($DATA(GMRCPRNM):"FOR "_GMRCPRNM,1:"")_" ON FILE. >"
- SET GMRCNPM=$EXTRACT(TAB,1,(80-$LENGTH(GMRCNPM))\80)_GMRCNPM
- SET ^TMP("GMRCR",$JOB,"CS",LNCT,0)=GMRCNPM
- Begin DoDot:1
- +1 IF $DATA(GMRCDT1)&($DATA(GMRCDT2))
- IF GMRCDT1'="ALL"
- SET LNCT=LNCT+1
- SET ^TMP("GMRCR",$JOB,"CS",LNCT,0)="Between Dates: "_$$FMTE^XLFDT(GMRCDT1)_" and "_$$FMTE^XLFDT(GMRCDT2)
- +2 IF $DATA(GMRCSTCK)
- IF $LENGTH(GMRCSTCK)
- SET LNCT=LNCT+1
- SET ^TMP("GMRCR",$JOB,"CS",LNCT,0)="With Status: "
- SET STS=""
- FOR I=1:1
- SET STS=$PIECE(GMRCSTCK,",",I)
- if STS=""
- QUIT
- SET ^TMP("GMRCR",$JOB,"CS",LNCT,0)=^(0)_$PIECE($GET(^ORD(100.01,+STS,0)),"^",1)_" "
- +3 QUIT
- End DoDot:1
- +4 IF '$TEST
- SET (BLK,LNCT)=LNCT-1
- SET ^TMP("GMRCR",$JOB,"CS",0)="^^^"_LNCT
- +5 IF $DATA(GMRCALFL)
- SET (BLK,LNCT)=1
- +6 KILL TO,TOD,END,FLG,GMRC(0),GMRCD,GMRCDG,GMRCIFN,GMRCFMDT,GMRCNPM,GMRCWARD
- +7 KILL I,PROC,STS,URG
- +8 QUIT
- OER(DFN,GMRCDG,GMRCDT1,GMRCDT2,GMRCSTCK,GMRCOER) ;;GUI interface for CPRS
- +1 ;;DFN=Patient internal file number
- +2 ;;GMRCDG: Internal file number of consult service from file 123.5
- +3 ;;GMRCDT1: Beginning date for lookup
- +4 ;;GMRCDT2: Ending date for lookup
- +5 ;;GMRCSTCK: IEN from OER Status File [^OER(100.01)] to screen results
- +6 ;; so that only consults with a desired status are displayed
- +7 ;; Can be sent as a set of statuses: i.e., 6,5,2
- +8 ;; (GMRCSTCK=GMRC STATUS CHECK)
- +9 ;;GMRCOER=0 if request is from CONSULTS
- +10 ;; =1 if request is for CPRS List Manager
- +11 ;; =2 if for CPRS GUI
- +12 IF GMRCDT1=""
- SET GMRCDT1="ALL"
- +13 IF GMRCDG=""
- SET GMRCDG=$ORDER(^GMR(123.5,"B","ALL SERVICES",0))
- +14 if '$DATA(GMRCOER)
- SET GMRCOER=1
- +15 DO SERV1^GMRCASV
- DO AD
- +16 KILL ^TMP("GMRCS",$JOB),^TMP("GMRCSLIST",$JOB)
- +17 QUIT
- SERVPROC ; Build contents of SERV/PROC field for List Manager
- +1 NEW TYPE,OTXT
- +2 SET TITLE=""
- +3 SET TYPE=""
- +4 SET OTXT=$PIECE($GET(^GMR(123,GMRCDA,1.11)),"^")
- +5 IF OTXT=""
- DO BUILD2
- +6 IF OTXT'=""
- DO BUILD1
- +7 QUIT
- BUILD1 ;OTXT does contain information
- +1 NEW FLG,BADFLG,TPROC,TTO,LEN,ABBRS,ABBRP
- +2 SET TPROC=$$UP^XLFSTR(PROC)
- SET TTO=$$UP^XLFSTR(TO)
- +3 SET TITLE=OTXT
- SET OTXT=$$UP^XLFSTR(OTXT)
- +4 SET BADFLG=0
- +5 IF PROC="Consult"
- SET FLG=1
- SET TYPE="Cons"
- +6 IF PROC'="Consult"
- SET FLG=0
- SET TYPE="Proc"
- +7 SET LEN=$LENGTH(TITLE)
- +8 IF TO=""
- SET TO="No Service"
- +9 IF LEN<30
- IF FLG=1
- IF OTXT'=TTO
- SET TITLE=TITLE_" "_TO_" "_TYPE
- QUIT
- +10 IF LEN<30
- IF FLG=1
- IF OTXT=TTO
- SET TITLE=TITLE_" "_TYPE
- QUIT
- +11 IF TO["<"
- SET BADFLG=1
- +12 SET ABBRS=$$SVC^GMRCAU(GMRCDA)
- SET ABBRP=$$PROC^GMRCAU(GMRCDA)
- +13 IF LEN<30
- IF FLG=0
- IF TPROC'=OTXT
- IF TTO'=TPROC
- SET TITLE=TITLE_" "_PROC_" "_TO_" "_TYPE
- QUIT
- +14 IF LEN<30
- IF FLG=0
- IF TPROC=OTXT
- IF TTO'=TPROC
- SET TITLE=TITLE_" "_TO_" "_TYPE
- QUIT
- +15 IF LEN<30
- IF FLG=0
- IF TPROC=OTXT
- IF TTO=TPROC
- SET TITLE=TITLE_" "_TYPE
- QUIT
- +16 IF LEN>30
- IF FLG=1
- IF TTO'=OTXT
- SET TITLE=TITLE_" "_TO_" "_TYPE
- QUIT
- +17 IF LEN>30
- IF FLG=1
- IF TTO=OTXT
- SET TITLE=TITLE_" "_TYPE
- QUIT
- +18 IF LEN>30
- IF FLG=0
- IF TPROC'=OTXT
- IF TTO'=TPROC
- SET TITLE=TITLE_" "_ABBRP_" "_TYPE
- QUIT
- +19 IF LEN>30
- IF FLG=0
- IF TTO'=OTXT
- IF BADFLG=0
- SET TITLE=TITLE_" "_ABBRS_" "_TYPE
- QUIT
- +20 IF LEN>30
- IF FLG=0
- IF TTO'=OTXT
- IF BADFLG=1
- SET TITLE=TITLE_" "_"<"_ABBRS_">"_TYPE
- QUIT
- +21 QUIT
- BUILD2 ;OTXT contains no information
- +1 NEW FLG,TPROC,TTO,LEN
- +2 SET TPROC=$$UP^XLFSTR(PROC)
- SET TTO=$$UP^XLFSTR(TO)
- +3 IF PROC="Consult"
- SET TITLE=TO
- SET LEN=$LENGTH(TITLE)
- SET FLG=1
- SET TYPE="Cons"
- +4 IF PROC'="Consult"
- SET TITLE=PROC
- SET LEN=$LENGTH(TITLE)
- SET FLG=0
- SET TYPE="Proc"
- +5 IF FLG=1
- SET TITLE=TITLE_" "_TYPE
- QUIT
- +6 IF FLG=0
- IF TTO=TPROC
- SET TITLE=TITLE_" "_TYPE
- QUIT
- +7 IF FLG=0
- IF TTO'=TPROC
- SET TITLE=TITLE_" "_TO_" "_TYPE
- QUIT
- +8 QUIT