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

GMRCSLM.m

Go to the documentation of this file.
  1. GMRCSLM ;SLC/DCM,JFR - List Mgr routine for consult tracking list ;9/8/99 14:52
  1. ;;3.0;CONSULT/REQUEST TRACKING;**1,4,14,12,22**;DEC 27, 1997
  1. EN ; -- main entry point for GMRC CONSULT TRACKING
  1. K GMRCOER
  1. S GMRCEN=1 K GMRCQUT
  1. ;IF Consults
  1. I $D(GMRCIS) D I $D(GMRCQUT) K GMRCEN,GMRCIS,GMRCQUT Q
  1. .N DIR,DIRUT,DTOUT,DUOUT,Y
  1. .S DIR(0)="SB^R:REQUESTING;C:CONSULTING"
  1. .S DIR("A")="Are you the Requesting site or the Consulting site"
  1. .D ^DIR I $D(DIRUT) S GMRCQUT=1 Q
  1. .S GMRCIS=Y
  1. D SP K GMRCEN I $D(GMRCQUT) K GMRCQUT Q
  1. D EN^VALM("GMRC CONSULT TRACKING")
  1. Q
  1. ;
  1. HDR ; -- header code
  1. ;override title if IF Consults
  1. I $D(GMRCIS) S VALM("TITLE")="IFC Requests: "_$S(GMRCIS="R":"Requesting",1:"Consulting")_" Site"
  1. D HDR1 ;format line 1 of header
  1. D:$L(GMRCWT) HDR2("")
  1. Q
  1. ;
  1. HDR1 ;format VALMHDR(1) with patient information
  1. N GMRCX,GMRCX1,GMRCX2,GMRCX3,TIUCWAD,GMRVSTR,X
  1. ;Expects DFN
  1. S GMRVSTR="WT" D EN6^GMRVUTL
  1. S GMRCWT="Wt.(lb): "_$S($L($P(X,U,8)):$P(X,U,8),1:"No Entry")
  1. D DEM^GMRCU ;returns GMRCPNM,GMRCSN,GMRCAGE,SEX,GMRCWARD,GMRCRB,GMRCDOB,GMRCWLI
  1. S GMRCX1=GMRCPNM_" "_GMRCSN
  1. ;
  1. S GMRCLOC=+$G(^DIC(42,+GMRCWLI,44))_";SC(" I 'GMRCLOC,'$D(XQAID) S GMRCLOC=""
  1. S GMRCX2="" I +$G(GMRCLOC) D
  1. . N L S L=$G(^SC(+GMRCLOC,0)),GMRCX2=$P(L,U,2)
  1. . S:'$L(GMRCX2) GMRCX2=$E($P(L,U),1,4)
  1. S:$L($G(GMRCRB)) GMRCX2=GMRCX2_"/"_GMRCRB
  1. ;
  1. S GMRCX=GMRCX1_$J(GMRCX2,40+($L(GMRCX2)\2)-$L(GMRCX1))
  1. S GMRCX3=" "_GMRCDOB_" ("_GMRCAGE_")"
  1. S TIUCWAD=$$CWAD^ORQPT2(+DFN) S:TIUCWAD]"" GMRCX3=GMRCX3_" <"_TIUCWAD_">"
  1. S VALMHDR(1)=GMRCX_$J(GMRCX3,79-$L(GMRCX))
  1. K VALMHDR(2)
  1. Q
  1. HDR2(GMRCX) ;format VALMHDR(2) with patient weight
  1. S VALMHDR(2)=$G(GMRCX)_$J($G(GMRCWT),79-$L($G(GMRCX)))
  1. Q
  1. ;
  1. INIT ; -- init variables and list array
  1. K ^TMP("GMRCR",$J,"LIST")
  1. S DSPLINE=0,DATA="",VALMAR="^TMP(""GMRCR"",$J,""LIST"")"
  1. F LINE=1:1:LNCT S DSPLINE=$O(^TMP("GMRCR",$J,"CS",DSPLINE)) Q:DSPLINE=""!(DSPLINE?1A.E) S DATA=^(DSPLINE,0) D SET^VALM10(LINE,DATA)
  1. S VALMCNT=LNCT,VALMPGE=1,XQORM("A")="Select Action: "
  1. K DSPLINE,DATA,LINE
  1. S:$D(^TMP("GMRC",$J,"CURRENT","MENU")) XQORM("HIJACK")=^("MENU")
  1. Q
  1. ;
  1. HELP ; -- help code
  1. N X,DX,DY D FULL^VALM1
  1. W !!,"Enter the display number of the item you wish to act on, or select an action."
  1. W !!,"If you'd like another view of the consults, enter CV."
  1. W !!,"Status key:",!?5,"'a' - active",?27,"'c' - complete",?50,"'dc' - discontinued",!?5,"'p' - pending",?27,"'x' - cancelled",?50,"'pr' - partial results",!?5,"'s' - scheduled",?27,"'e' - expired"
  1. W !!,"Enter ?? to see a list of actions available for navigating the list."
  1. W !!,"Press <return> to continue ..." R X:DTIME
  1. S VALMBCK="R"
  1. ; S VALMSG=$$MSG
  1. S (DX,DY)=0 X ^%ZOSF("XY")
  1. D EXIT^GMRCSLMA("R")
  1. Q
  1. ;
  1. EXIT ; -- exit code
  1. K ^TMP("GMRCR",$J,"LIST")
  1. K VALMCNT,VALMBCK,VALMPGE
  1. D ^GMRCREXT
  1. Q
  1. ;
  1. PHYEN ;Entry Point When Provider's service is known and only needs to look at consults for that service
  1. Q:'$D(DUZ) Q:'$D(^VA(200,DUZ,5)) Q:'$L(^VA(200,DUZ,5))
  1. S DIC="^DIC(49,",DIC(0)="MNO",X=^VA(200,DUZ,5) D ^DIC K DIC S GMRCSSNM=$S($L($P(Y,"^",2)):$P(Y,"^",2),1:"") I $L(GMRCSSNM) S GMRCSS=$O(^GMR(123.5,"B",GMRCSSNM,0))
  1. S GMRCFL=1 D SP I $D(GMRCQUT),GMRCQUT=1 Q
  1. D SPD I $D(GMRCQUT) D END,EXIT Q
  1. K GMRCFL
  1. D AD^GMRCSLM1
  1. I GMRCSSNM'["MEDICINE" D EN^VALM("GMRC CONSULT TRACKING"),END,EXIT Q
  1. D EN^VALM("GMRC TRK MEDICINE CONSULTS"),END,EXIT Q
  1. Q
  1. SP ;;Select a new patient and return DFN and GMRCSSNM to display consults and requested Service.
  1. I $D(VALM) D FULL^VALM1
  1. K GMRCQUT S GMRCDFN1=$S($D(DFN):DFN,1:0)
  1. D SELPT^GMRCS I $S($D(GMRCQUT):1,'$D(DFN):1,1:0) S GMRCQUT=1,DFN=GMRCDFN1 G SPK
  1. I $D(Y),Y<0&(X["^") S GMRCQUT=1 G SPK
  1. I $D(Y),Y<0 S DFN=GMRCDFN1 S GMRCQUT=1 G SPK
  1. I $D(GMRC("NMBR")) D RESET^GMRCSLMV(GMRC("NMBR")) K GMRC("NMBR")
  1. S GMRCWRD=GMRCWARD
  1. I $D(GMRCFL) D SPK Q
  1. D ASRV^GMRCASV I $S($D(GMRCQUT):1,$D(DTOUT):1,$D(DUOUT):1,1:0) K DTOUT,DIROUT,DUOUT S (GMRCQUT,GMRCQIT)=1 Q
  1. S GMRCSS=GMRCDG,GMRCSSNM=$P(^GMR(123.5,GMRCSS,0),"^",1) S GMRCSTCK=""
  1. D EN^GMRCMENU
  1. SPD ;Enter a date range for serching consults; null entry selects all consults and does not exclude by date
  1. D ^GMRCSPD Q:$D(GMRCQUT)
  1. I $D(GMRCEN) D SPK Q ;GMRCEN defined if branched to here from EN^GMRCSLM
  1. S GMRCOER=0
  1. D AD^GMRCSLM1 ;Do not delete. Needed to get new Pt. data into ^TMP("GMRCR",
  1. S VALMCNT=LNCT,VALMBCK="R",VALMPGE=1 K GMRCDFN1
  1. Q
  1. SPQ ;New patient has not been selected - keep current patient
  1. I '$D(DFN),GMRCDFN1<1 S GMRCQUT=1 K GMRCDFN1 Q
  1. S DFN=GMRCDFN1 Q:DFN<1 W " "_GMRCPNM K GMRCDFN1
  1. S VALMBCK="R",GMRCQUT=1 K GMRCDFN1
  1. SPK ;Kill variables
  1. ;I $D(GMRCTM),$D(GMRCBM),$D(IOSTBM) S IOTM=GMRCTM,IOBM=IOSTBM
  1. K GMRCDFN1,GMRCBM,GMRCTM
  1. Q
  1. SS ;Select A New Service or ALL SERVICES to Display Patient Consults
  1. K GMRCQUT,GMRCVP S GMRCOER=0
  1. D FULL^VALM1
  1. D ASRV^GMRCASV I $D(GMRCQUT),GMRCQUT=1 Q
  1. S GMRCSS=GMRCDG,GMRCSSNM=$P(^GMR(123.5,GMRCSS,0),"^",1)
  1. D AD^GMRCSLM1,INIT,HDR
  1. S VALMBCK="R",VALMCNT=LNCT
  1. D EN^GMRCACTM,EN^GMRCMENU
  1. I $D(GMRC("NMBR")) D RESET^GMRCSLMV(GMRC("NMBR")) K GMRC("NMBR")
  1. Q
  1. STS ;Select a status for view. i.e., only active, pendings, DC'd, etc.
  1. I $D(IOTM),$D(IOBM),$D(IOSTBM) D FULL^VALM1
  1. S GMRCERR=0
  1. N DIR,X,Y
  1. S DIR(0)="SAOM^dc:Discontinued;c:Complete;p:Pending;a:Active;pr:Partial Results;s:Scheduled;x:Cancelled"
  1. S $P(DIR(0),U,2)="al:All Status's;"_$P(DIR(0),U,2)
  1. S DIR("A")="Only Display Consults With Status of: "
  1. S DIR("B")="All Status's"
  1. I $G(GMRCSTCK) D
  1. . S DIR("A")="Another Status to display: "
  1. . K DIR("B")
  1. D ^DIR
  1. I $D(DUOUT)!($D(DTOUT))!('$L(Y)) G END
  1. D STCK($$LOW^XLFSTR(Y)) I $G(GMRCSTCK)="" D:$D(GMRC("NMBR")) G END
  1. . D RESET^GMRCSLMV(GMRC("NMBR"))
  1. . K GMRC("NMBR")
  1. . Q
  1. I $D(GMRC("NMBR")) D RESET^GMRCSLMV(GMRC("NMBR")) K GMRC("NMBR")
  1. G STS
  1. STCK(RES) ;change code to status
  1. N CODE
  1. I RES="al" S GMRCSTCK="" Q
  1. I RES="dc" S CODE=1
  1. I RES="c" S CODE=2
  1. I RES="p" S CODE=5
  1. I RES="a" S CODE=6
  1. I RES="pr" S CODE=9
  1. I RES="x" S CODE=13
  1. I RES="s" S CODE=8
  1. I $D(GMRCSTCK) I $$FND(CODE) W $C(7),!,"Already selected" Q
  1. I +$G(GMRCSTCK) S GMRCSTCK=GMRCSTCK_","_CODE Q
  1. S GMRCSTCK=CODE
  1. Q
  1. FND(CD) ;status already selected?
  1. I GMRCSTCK=CD Q 1
  1. I $F(GMRCSTCK,(CD_",")) Q 1
  1. I $E(GMRCSTCK,$L(GMRCSTCK))=CD Q 1
  1. Q 0
  1. END K DIR,GMRCERR,Y
  1. Q