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

RMPREO.m

Go to the documentation of this file.
  1. RMPREO ;HINES/HNC - SUSPENSE PROCESSING; MARCH 10, 2005
  1. ;;3.0;PROSTHETICS;**45,55,83,182,191,212**;Feb 09, 1996;Build 5
  1. ;
  1. ;HNC #83, add free text ordering provider 3/10/05
  1. ;
  1. ;RMPR*3.0*182 Add Urgency flag to List Manager Suspense
  1. ; List and print template RPMR VIEW REQUEST
  1. ; for action 'View Request'
  1. ; Also, adds check that will insure variable
  1. ; RMPRSITE is undefined rather than test for
  1. ; array RMPR defined as a viable site exists
  1. ; in RMPRSITE.
  1. ;
  1. ;RMPR*3.0*191 Ensure array element RMPR("STA") is defined
  1. ; before further processing.
  1. ;
  1. ;RMPR*3.0*212 Resorts List by SUSPENSE DATE (RMPREO NEW)
  1. ; rather than by IEN (RMPREO).
  1. ;
  1. EN ; -- main entry point for RMPREO
  1. D ^%ZISC
  1. N STRING,CLREND,COLUMN,LINE,ON,OFF
  1. ;get patient to test with
  1. K ^TMP($J,"RMPREO")
  1. K ^TMP($J,"RMPREOEE")
  1. K ^TMP($J,"RMPREO NEW")
  1. ;ask station
  1. I '$D(RMPRSITE)!'$D(RMPR("STA")) D DIV4^RMPRSIT Q:$D(X) ;RMPR*3.0*182, 191
  1. I '$D(RMPRDFN) D GETPAT^RMPRUTIL Q:'$D(RMPRDFN)
  1. D EN^VALM("RMPREO")
  1. Q
  1. ;
  1. HDR ; -- header code
  1. N VA,VADM
  1. S DFN=RMPRDFN
  1. D DEM^VADPT
  1. ;S VALMHDR(1)="Suspense Processing"
  1. S VALMHDR(1)="Open/Pending/Closed Suspense for "_$$LOWER^VALM1(VADM(1))_" ("_$P(VADM(2),U,2)_") '!' = STAT" ;RMPR*3.0*182
  1. D KVAR^VADPT
  1. Q
  1. ;
  1. INIT ; -- init variables and list array
  1. K ^TMP($J,"RMPREO"),^TMP($J,"RMPREOEE")
  1. D HDR
  1. N RMPRA,CDATE,LINE,X,RMPRSTAT ;RMPR*3*182
  1. N SDATE ;RMPR*3*212
  1. ;start loop
  1. ;
  1. K ADATE,PDAY
  1. S RMPRA="",VALMCNT=0,RRX=""
  1. ;reverse order display
  1. F S RMPRA=$O(^RMPR(668,"C",RMPRDFN,RMPRA),-1) Q:RMPRA="" D
  1. .I $P(^RMPR(668,RMPRA,0),U,10)="X" Q
  1. .S VALMCNT=VALMCNT+1,LINE=VALMCNT
  1. .S RRX=$$SETFLD^VALM1(LINE,RRX,"LINE")
  1. .S RMPRSTAT="" I $P($G(^RMPR(668,RMPRA,8)),U,5)["STAT" S RMPRSTAT="!" ;RMPR*3*182
  1. .S CDATE=$P(^RMPR(668,RMPRA,0),U,1),CDATE=$$DAT1^RMPRUTL1(CDATE)_RMPRSTAT ;RMPR*3*182
  1. .S SDATE=$P(^RMPR(668,RMPRA,0),U) ;RMPR*3*212
  1. .S RRX=$$SETFLD^VALM1(CDATE,RRX,"DATE")
  1. .S WHO1=""
  1. .I $P(^RMPR(668,RMPRA,0),U,11)'="" S WHO1=$$WHO^RMPREOU($P(^RMPR(668,RMPRA,0),U,11),12,RMPRA)
  1. .I $P($G(^RMPR(668,RMPRA,"IFC1")),U,3)'="" S WHO1=$$WHO^RMPREOU("",12,RMPRA)
  1. .;
  1. .S RRX=$$SETFLD^VALM1(WHO1,RRX,"WHO")
  1. .K WHO,WHO1
  1. .;type
  1. .S TYPE=$$TYPE^RMPREOU(RMPRA,8)
  1. .S RRX=$$SETFLD^VALM1(TYPE,RRX,"TYPE")
  1. .;display description if manual
  1. .;
  1. .S RRX=$$SETFLD^VALM1($$DES^RMPREOU(RMPRA,22),RRX,"DES")
  1. .;init activation date
  1. .S ADATE="",PDAY="",WRKDAY=""
  1. .S ADATE=$P(^RMPR(668,RMPRA,0),U,9)
  1. .I ADATE'="" S (PDAY,WRKDAY)=$$WRKDAY^RMPREOU(RMPRA)
  1. .I ADATE="" S (PDAY,WRKDAY)=$$CWRKDAY^RMPREOU(RMPRA)
  1. .S RRX=$$SETFLD^VALM1($$DAT1^RMPRUTL1(ADATE),RRX,"INITIAL ACTION DATE")
  1. .I ADATE'="" S CDAY=$$PDAY^RMPREOU(RMPRA) I CDAY>7 S PDAY="*"_WRKDAY
  1. .I ADATE=""&(WRKDAY>5) S PDAY="@"_WRKDAY
  1. .S RRX=$$SETFLD^VALM1(PDAY,RRX,"PDAY")
  1. .K ADATE,PDAY,WRKDAY,CDAY
  1. .;S R660=""
  1. .;F S R660=$O(^RMPR(668,RMPRA,6,"B",R660)) Q:R660'>0 D
  1. .; .S RRX=$$SETFLD^VALM1($$ITEM^RMPREOU(R660,17),RRX,"ITEM")
  1. .S RRX=$$SETFLD^VALM1($$STATUS^RMPREOU(RMPRA,7),RRX,"STATUS")
  1. .S ^TMP($J,"RMPREO",LINE,0)=RRX
  1. .S ^TMP($J,"RMPREOEE",LINE,0)=RMPRA
  1. .S ^TMP($J,"RMPREO NEW",SDATE,LINE,RMPRA)=RRX ;resort array for RMPR*3*212
  1. ;resort RMPREO using RMPREO NEW;RMPR*3*212
  1. I $D(^TMP($J,"RMPREO NEW")),$$SORT(SDATE) K ^TMP($J,"RMPREO NEW")
  1. Q
  1. ;
  1. SORT(SDATE) ;reorder RMPREO using RMPREO NEW;RMPR*3*212
  1. N NL,SD,LINE,X,RMPRN K ^TMP($J,"RMPREO"),^TMP($J,"RMPREOEE")
  1. S SD="",NL=1 F S SD=$O(^TMP($J,"RMPREO NEW",SD),-1) Q:SD<1 D
  1. .S LINE=0 F S LINE=$O(^TMP($J,"RMPREO NEW",SD,LINE)) Q:LINE<1 D
  1. ..S RMPRN=$O(^TMP($J,"RMPREO NEW",SD,LINE,0))
  1. ..S X=^TMP($J,"RMPREO NEW",SD,LINE,RMPRN),^TMP($J,"RMPREOEE",NL,0)=RMPRN
  1. ..S X=$$SETFLD^VALM1(NL,X,"LINE"),^TMP($J,"RMPREO",NL,0)=X,NL=NL+1
  1. Q 1
  1. ;
  1. SET(STRING,LINE,COLUMN,CLREND,ON,OFF) ;set array
  1. I '$D(@VALMAR@(LINE,0)) D SET^VALM10(LINE,$J("",80))
  1. D SET^VALM10(LINE,$$SETSTR^VALM1(STRING,@VALMAR@(LINE,0),COLUMN,CLREND))
  1. I $G(ON)]""!($G(OFF)]"") D CNTRL^VALM10(LINE,COLUMN,$L(STRING),ON,OFF)
  1. Q
  1. ;
  1. ;
  1. HELP ; -- help code
  1. S X="?" D DISP^XQORM1 W !!
  1. Q
  1. ;
  1. EXIT ; -- exit code
  1. ;NOT XUSCLEAN
  1. K ^TMP($J,"RMPREO")
  1. K ^TMP($J,"RMPREOEE")
  1. K ^TMP($J,"RMPREO NEW")
  1. K RMPRDFN
  1. Q
  1. ;
  1. EXPND ; -- expand code
  1. Q
  1. ;