RMPRSP ;HINES-IO/HNC-PRINT SUSPENSE RECORDS ;7/28/00
;;3.0;PROSTHETICS;**45,55,77**;Feb 09, 1996
;RVD 3/17/03 patch #77 - allow queing to p-message. IO to ION
;
;station from CPRS may not be the same as site params, can not filter
;station is from duz(2), the division in file 200, or
;default institution in kernel system parameters file 8989.3.
;
EN ;main entry point
S %ZIS="MQ" K IOP D ^%ZIS G:POP EXIT
I '$D(IO("Q")) U IO G PRINT
K IO("Q") S ZTDESC="PRINT OPEN PENDING SUSPENSE RECORDS",ZTRTN="PRINT^RMPRSP",ZTIO=ION
D ^%ZTLOAD W:$D(ZTSK) !,"REQUEST QUEUED!" H 1 G EXIT
;
PRINT ;print
W:$E(IOST)["C" @IOF
I '$D(IO("Q")) U IO
;
MAIN ;main sort logic
;VARIABLES SET: ST - STATUS
; RO - ENTRY NUMBER IN SUSPENSE
;
K RMPREND,^TMP($J)
S RMPRPAGE=1 D HEADER1
;
S ST="C"
F S ST=$O(^RMPR(668,"E",ST)) Q:ST="" Q:ST="X" D
.S RO=0
.F S RO=$O(^RMPR(668,"E",ST,RO)) Q:RO'>0 D
. .Q:$P(^RMPR(668,RO,0),U,10)="X"
. .Q:$P(^RMPR(668,RO,0),U,10)="C"
. .S DATE=$P($P(^RMPR(668,RO,0),U,1),".",1)
. .S DFN=$P(^RMPR(668,RO,0),U,2) Q:DFN=""
. .D DEM^VADPT
. .S ^TMP($J,DATE,VADM(1),RO)=""
. .K DFN
;end sort
;
I '$D(^TMP($J)) W !,"No Open/Pending Suspense Records",! G EXIT
;
S DATE=0
F S DATE=$O(^TMP($J,DATE)) Q:DATE'>0 Q:$D(RMPREND) D
.S NAME=""
.F S NAME=$O(^TMP($J,DATE,NAME)) Q:NAME="" Q:$D(RMPREND) D
. .S RO=0
. .F S RO=$O(^TMP($J,DATE,NAME,RO)) Q:RO="" Q:$D(RMPREND) D
. . .K VADM S DFN=$P(^RMPR(668,RO,0),U,2) D DEM^VADPT
. . .I $Y>(IOSL-6),$E(IOST)["C",$G(RMPRFL)'="" D HEADER Q:$D(RMPREND)
. . .D DISPLAY
. . .W !,$$REPEAT^XLFSTR("-",79)
D EXIT
Q
;
DISPLAY ;display record
W !,$$DAT1^RMPRUTL1(DATE)
W ?10,$E(VADM(1),0,18)
W ?28,$P($P(VADM(2),U,2),"-",3)
W ?34,$$STATUS^RMPREOU(RO,4)," "
S WRKDAY=$$CWRKDAY^RMPREOU(RO) W WRKDAY
W ?44,$$TYPE^RMPREOU(RO,8)
I $P(^RMPR(668,RO,0),U,7)'="" W ?59,$P(^DIC(4,$P(^RMPR(668,RO,0),U,7),0),U,1)
W !,$$DES^RMPREOU(RO,79)
S INIA=$P(^RMPR(668,RO,0),U,9),INIDAY=$$WRKDAY^RMPREOU(RO)
I INIA'="" W !,"**Initial Action Date: ",$$DAT1^RMPRUTL1(INIA)," (",INIDAY," Working Days)"
;then display the number of working days to init action.
I S INIAN=0 D
.F S INIAN=$O(^RMPR(668,RO,3,INIAN)) Q:INIAN="" D
. .W !,^RMPR(668,RO,3,INIAN,0)
S ODAT=0
F S ODAT=$O(^RMPR(668,RO,1,ODAT)) Q:ODAT'>0 D
.S ODAT1=$P(^RMPR(668,RO,1,ODAT,0),U,1)
.W !,"**Other Action Date: ",$$DAT1^RMPRUTL1(ODAT1)
.S ODATN=0
.F S ODATN=$O(^RMPR(668,RO,1,ODAT,1,ODATN)) Q:ODATN="" D
. .W !,^RMPR(668,RO,1,ODAT,1,ODATN,0)
K INIAN,ODATN,ODAT,ODAT1
Q
;
;
Q:$D(RMPREND) S RMPRFL=1
W !,"Prosthetics Open/Pending Suspense File List "
N X,Y,% D NOW^%DTC S Y=% D DD^%DT S Y=$TR(Y,"@"," ") W $P(Y,":",1,2)
;W ?70,"STA ",$$STA^RMPRUTIL
W !,"DATE",?10,"PATIENT",?28,"SSN",?34,"STATUS",?44,"TYPE",?59,"STATION",?73,"PAGE ",RMPRPAGE
W !,$$REPEAT^XLFSTR("-",79) S RMPRPAGE=RMPRPAGE+1 I $D(RMPRFLG) W !,"CON'T" K RMPRFLG
Q
;
EXIT K ^TMP($J) D ^%ZISC,KILL^XUSCLEAN
Q
;end
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRSP 3163 printed Oct 16, 2024@18:38:23 Page 2
RMPRSP ;HINES-IO/HNC-PRINT SUSPENSE RECORDS ;7/28/00
+1 ;;3.0;PROSTHETICS;**45,55,77**;Feb 09, 1996
+2 ;RVD 3/17/03 patch #77 - allow queing to p-message. IO to ION
+3 ;
+4 ;station from CPRS may not be the same as site params, can not filter
+5 ;station is from duz(2), the division in file 200, or
+6 ;default institution in kernel system parameters file 8989.3.
+7 ;
EN ;main entry point
+1 SET %ZIS="MQ"
KILL IOP
DO ^%ZIS
if POP
GOTO EXIT
+2 IF '$DATA(IO("Q"))
USE IO
GOTO PRINT
+3 KILL IO("Q")
SET ZTDESC="PRINT OPEN PENDING SUSPENSE RECORDS"
SET ZTRTN="PRINT^RMPRSP"
SET ZTIO=ION
+4 DO ^%ZTLOAD
if $DATA(ZTSK)
WRITE !,"REQUEST QUEUED!"
HANG 1
GOTO EXIT
+5 ;
PRINT ;print
+1 if $EXTRACT(IOST)["C"
WRITE @IOF
+2 IF '$DATA(IO("Q"))
USE IO
+3 ;
MAIN ;main sort logic
+1 ;VARIABLES SET: ST - STATUS
+2 ; RO - ENTRY NUMBER IN SUSPENSE
+3 ;
+4 KILL RMPREND,^TMP($JOB)
+5 SET RMPRPAGE=1
DO HEADER1
+6 ;
+7 SET ST="C"
+8 FOR
SET ST=$ORDER(^RMPR(668,"E",ST))
if ST=""
QUIT
if ST="X"
QUIT
Begin DoDot:1
+9 SET RO=0
+10 FOR
SET RO=$ORDER(^RMPR(668,"E",ST,RO))
if RO'>0
QUIT
Begin DoDot:2
+11 if $PIECE(^RMPR(668,RO,0),U,10)="X"
QUIT
+12 if $PIECE(^RMPR(668,RO,0),U,10)="C"
QUIT
+13 SET DATE=$PIECE($PIECE(^RMPR(668,RO,0),U,1),".",1)
+14 SET DFN=$PIECE(^RMPR(668,RO,0),U,2)
if DFN=""
QUIT
+15 DO DEM^VADPT
+16 SET ^TMP($JOB,DATE,VADM(1),RO)=""
+17 KILL DFN
End DoDot:2
End DoDot:1
+18 ;end sort
+19 ;
+20 IF '$DATA(^TMP($JOB))
WRITE !,"No Open/Pending Suspense Records",!
GOTO EXIT
+21 ;
+22 SET DATE=0
+23 FOR
SET DATE=$ORDER(^TMP($JOB,DATE))
if DATE'>0
QUIT
if $DATA(RMPREND)
QUIT
Begin DoDot:1
+24 SET NAME=""
+25 FOR
SET NAME=$ORDER(^TMP($JOB,DATE,NAME))
if NAME=""
QUIT
if $DATA(RMPREND)
QUIT
Begin DoDot:2
+26 SET RO=0
+27 FOR
SET RO=$ORDER(^TMP($JOB,DATE,NAME,RO))
if RO=""
QUIT
if $DATA(RMPREND)
QUIT
Begin DoDot:3
+28 KILL VADM
SET DFN=$PIECE(^RMPR(668,RO,0),U,2)
DO DEM^VADPT
+29 IF $Y>(IOSL-6)
IF $EXTRACT(IOST)["C"
IF $GET(RMPRFL)'=""
DO HEADER
if $DATA(RMPREND)
QUIT
+30 DO DISPLAY
+31 WRITE !,$$REPEAT^XLFSTR("-",79)
End DoDot:3
End DoDot:2
End DoDot:1
+32 DO EXIT
+33 QUIT
+34 ;
DISPLAY ;display record
+1 WRITE !,$$DAT1^RMPRUTL1(DATE)
+2 WRITE ?10,$EXTRACT(VADM(1),0,18)
+3 WRITE ?28,$PIECE($PIECE(VADM(2),U,2),"-",3)
+4 WRITE ?34,$$STATUS^RMPREOU(RO,4)," "
+5 SET WRKDAY=$$CWRKDAY^RMPREOU(RO)
WRITE WRKDAY
+6 WRITE ?44,$$TYPE^RMPREOU(RO,8)
+7 IF $PIECE(^RMPR(668,RO,0),U,7)'=""
WRITE ?59,$PIECE(^DIC(4,$PIECE(^RMPR(668,RO,0),U,7),0),U,1)
+8 WRITE !,$$DES^RMPREOU(RO,79)
+9 SET INIA=$PIECE(^RMPR(668,RO,0),U,9)
SET INIDAY=$$WRKDAY^RMPREOU(RO)
+10 IF INIA'=""
WRITE !,"**Initial Action Date: ",$$DAT1^RMPRUTL1(INIA)," (",INIDAY," Working Days)"
+11 ;then display the number of working days to init action.
+12 IF $TEST
SET INIAN=0
Begin DoDot:1
+13 FOR
SET INIAN=$ORDER(^RMPR(668,RO,3,INIAN))
if INIAN=""
QUIT
Begin DoDot:2
+14 WRITE !,^RMPR(668,RO,3,INIAN,0)
End DoDot:2
End DoDot:1
+15 SET ODAT=0
+16 FOR
SET ODAT=$ORDER(^RMPR(668,RO,1,ODAT))
if ODAT'>0
QUIT
Begin DoDot:1
+17 SET ODAT1=$PIECE(^RMPR(668,RO,1,ODAT,0),U,1)
+18 WRITE !,"**Other Action Date: ",$$DAT1^RMPRUTL1(ODAT1)
+19 SET ODATN=0
+20 FOR
SET ODATN=$ORDER(^RMPR(668,RO,1,ODAT,1,ODATN))
if ODATN=""
QUIT
Begin DoDot:2
+21 WRITE !,^RMPR(668,RO,1,ODAT,1,ODATN,0)
End DoDot:2
End DoDot:1
+22 KILL INIAN,ODATN,ODAT,ODAT1
+23 QUIT
+24 ;
SET DIR(0)="E"
DO ^DIR
KILL DIR
if Y<1
SET RMPREND=1
if Y=""!(Y=0)
QUIT
WRITE @IOF
+1 ;
+1 if $DATA(RMPREND)
QUIT
SET RMPRFL=1
+2 WRITE !,"Prosthetics Open/Pending Suspense File List "
+3 NEW X,Y,%
DO NOW^%DTC
SET Y=%
DO DD^%DT
SET Y=$TRANSLATE(Y,"@"," ")
WRITE $PIECE(Y,":",1,2)
+4 ;W ?70,"STA ",$$STA^RMPRUTIL
+5 WRITE !,"DATE",?10,"PATIENT",?28,"SSN",?34,"STATUS",?44,"TYPE",?59,"STATION",?73,"PAGE ",RMPRPAGE
+6 WRITE !,$$REPEAT^XLFSTR("-",79)
SET RMPRPAGE=RMPRPAGE+1
IF $DATA(RMPRFLG)
WRITE !,"CON'T"
KILL RMPRFLG
+7 QUIT
+8 ;
EXIT KILL ^TMP($JOB)
DO ^%ZISC
DO KILL^XUSCLEAN
+1 QUIT
+2 ;end
