RMPRHL ;PHX/JLT-ENTER/EDIT/PRINT HOME LIAISON VISITS ;8/29/1994
;;3.0;PROSTHETICS;;Feb 09, 1996
OP ;OPEN HOME/LIAISON VISITS
W ! D DIV4^RMPRSIT G:$D(X) EXIT K DA,Y,DIR S DIR(0)="665.1,.01O",DIR("A")="Enter HOME/LIAISON VISIT DATE OPENED" D ^DIR G:$D(DIRUT)!($D(DTOUT)) EXIT S DIC(0)="ZL",DIC="^RMPR(665.1,",X=Y,DLAYGO=665.1
K D0,DD,DO D FILE^DICN K DLAYGO G:+Y'>0 OP
K DIR S (RMPRA,DA)=+Y,DIE=DIC,RMPRSEM=";"
L +^RMPR(665.1,RMPRA,0):1 I $T=0 W $C(7),?5,!,"Someone else is editing this record" G EXIT
S DR="1;I $P(^RMPR(665.1,DA,0),U,2)="""" S Y="""";6////^S X=RMPR(""STA"");I $P($P(^RMPR(665.1,DA,0),U,2),RMPRSEM,2)[""DPT("" S Y=""@1"";2//^S X=""LIAISON"";3;5;S Y=""@3"";@1;2//^S X=""HOME"";3;5;"
S DR=DR_"@3;4;I '$P(^RMPR(665.1,DA,0),U,5) S Y="""";4.5"
D ^DIE L -^RMPR(665.1,RMPRA,0) I $P(^RMPR(665.1,DA,0),U,2)=""!($P(^(0),U,3)="")!($P(^(0),U,4)="") S DIK="^RMPR(665.1," D ^DIK W !!,?5,$C(7),"Deleted...",! G OP
I '$P(^RMPR(665.1,DA,0),U,5)!($P(^(0),U,6)="") S DR="4///@;4.5///@" D ^DIE W !!,?5,$C(7),"VISIT HAS NOT BEEN CLOSED OUT"
G OP
CL ;CLOSE HOME/LIAISON VISITS
W !! D DIV4^RMPRSIT G:$D(X) EXIT S DIC(0)="AEQM",DIC=665.1,DIC("A")="Select HOME/LIAISON VISIT DATE OPENED: ",DIC("W")="W "" "" D DSP^RMPRHL",DIC("S")="I $P(^(0),U,7)=RMPR(""STA"")" K Y D ^DIC G:+Y'>0 EXIT
S RMPRA=+Y L +^RMPR(665.1,RMPRA,0):1 I $T=0 W $C(7),?5,!,"Someone else is Editing this entry!" G EXIT
S DA=+Y,DIE=DIC,DR="4;I '$P(^RMPR(665.1,DA,0),U,5) S Y="""";4.5" W ! D ^DIE I '$P(^RMPR(665.1,DA,0),U,5)!($P(^(0),U,6)="") S DR="4///@;4.5///@" D ^DIE W !!,?5,$C(7),"VISIT HAS NOT BEEN CLOSED OUT"
L -^RMPR(665.1,RMPRA,0) G CL
ED ;EDIT/DELETE HOME/LIAISON VISITS
W ! D DIV4^RMPRSIT G:$D(X) EXIT
S DIC("S")="I $P(^(0),U,7)=RMPR(""STA"")",DIC(0)="AEQM",DIC=665.1,DIC("A")="Select HOME/LIAISON VISIT DATE OPENED: ",DIC("W")="W "" "" D DSP^RMPRHL" D ^DIC G:+Y'>0 EXIT
S RMPRA=+Y L +^RMPR(665.1,RMPRA,0):1 I $T=0 W !,$C(7),?5,"Someone else is Editing this entry!" G EXIT
S DA=+Y,DIE=DIC,DR=".01;1R;2;3;5;I '$P(^RMPR(665.1,DA,0),U,5) S Y="""";4;4.5" D ^DIE I $D(DA) I '$P(^RMPR(665.1,DA,0),U,5)!($P(^(0),U,6)="") S DR="4///@;4.5///@" D ^DIE
L -^RMPR(665.1,RMPRA,0) G ED
PO ;PRINT OPEN HOME/LIAISON VISITS
S L=0,BY="[RMPR OPEN VISITS]",DIC="^RMPR(665.1,",FLDS="[RMPR OPEN VISITS]",DHIT="S $P(RL,""-"",IOM)="""" W:$Y>6 RL",DIOEND="I IOST[""C-"" S RX=""I $Y<21 F W ! Q:$Y>21"",DIR(0)=""E"" X RX D ^DIR" D EN1^DIP G EXIT
CV ;PRINT CLOSED HOME/LIAISON VISITS
S L=0,BY="[RMPR CLOSED VISITS]",DIC="^RMPR(665.1,",FLDS="[RMPR CLOSED VISITS]",DHIT="S $P(RL,""-"",IOM)="""" W:$Y>6 RL",DIOEND="I IOST[""C-"" S RX=""I $Y<21 F W ! Q:$Y>21"",DIR(0)=""E"" X RX D ^DIR" D EN1^DIP G EXIT
EXIT K RX,DA,RL,Y,DIC,DR,DIR,DIE,DIK,FLDS,DHIT,L,BY,RMPRSEM,RMPRA Q
DSP ;DISPLAY HOME/LIAISON VISITS
I $P($P(^RMPR(665.1,+Y,0),";",2),U,1)="DIC(4," D DSPI Q
I $P($P(^RMPR(665.1,+Y,0),";",2),U,1)="PRC(440," D DSPV Q
W ?20,$E($P(^DPT(+$P(^RMPR(665.1,+Y,0),U,2),0),U),1,20),?40," ",$S($P(^RMPR(665.1,+Y,0),U,3)'="":$S($P(^(0),U,3)["H":"HOME",1:"LIAISON"),1:""),?60 I $P(^(0),U,4) W $E($P(^VA(200,$P(^(0),U,4),0),U),1,15) Q
DSPI W ?20,$E($P(^DIC(4,+$P(^RMPR(665.1,+Y,0),U,2),0),U),1,20),?40," ",$S($P(^RMPR(665.1,+Y,0),U,3)'="":$S($P(^(0),U,3)["H":"HOME",1:"LIAISON"),1:""),?60 I $P(^(0),U,4) W $E($P(^VA(200,$P(^(0),U,4),0),U),1,15) Q
DSPV W ?20,$E($P(^PRC(440,+$P(^RMPR(665.1,+Y,0),U,2),0),U),1,20),?40," ",$S($P(^RMPR(665.1,+Y,0),U,3)'="":$S($P(^(0),U,3)["H":"HOME",1:"LIAISON"),1:""),?60 I $P(^(0),U,4) W $E($P(^VA(200,$P(^(0),U,4),0),U),1,15) Q
TRS ;INPUT TRANSFORM FOR TOTAL HOURS
;Hours field, under Technician mult., in file 664.3
I +X'=X!(X>999)!(X<0)!(X?.E1"."3N.N) K X Q
I $P(X,".",2)="" Q
I $P(X,".",2)="5" Q
I $P(X,".",2)="75" Q
I $P(X,".",2)="25" Q
K X Q
;END
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRMPRHL 3790 printed Dec 13, 2024@02:34:54 Page 2
RMPRHL ;PHX/JLT-ENTER/EDIT/PRINT HOME LIAISON VISITS ;8/29/1994
+1 ;;3.0;PROSTHETICS;;Feb 09, 1996
OP ;OPEN HOME/LIAISON VISITS
+1 WRITE !
DO DIV4^RMPRSIT
if $DATA(X)
GOTO EXIT
KILL DA,Y,DIR
SET DIR(0)="665.1,.01O"
SET DIR("A")="Enter HOME/LIAISON VISIT DATE OPENED"
DO ^DIR
if $DATA(DIRUT)!($DATA(DTOUT))
GOTO EXIT
SET DIC(0)="ZL"
SET DIC="^RMPR(665.1,"
SET X=Y
SET DLAYGO=665.1
+2 KILL D0,DD,DO
DO FILE^DICN
KILL DLAYGO
if +Y'>0
GOTO OP
+3 KILL DIR
SET (RMPRA,DA)=+Y
SET DIE=DIC
SET RMPRSEM=";"
+4 LOCK +^RMPR(665.1,RMPRA,0):1
IF $TEST=0
WRITE $CHAR(7),?5,!,"Someone else is editing this record"
GOTO EXIT
+5 SET DR="1;I $P(^RMPR(665.1,DA,0),U,2)="""" S Y="""";6////^S X=RMPR(""STA"");I $P($P(^RMPR(665.1,DA,0),U,2),RMPRSEM,2)[""DPT("" S Y=""@1"";2//^S X=""LIAISON"";3;5;S Y=""@3"";@1;2//^S X=""HOME"";3;5;"
+6 SET DR=DR_"@3;4;I '$P(^RMPR(665.1,DA,0),U,5) S Y="""";4.5"
+7 DO ^DIE
LOCK -^RMPR(665.1,RMPRA,0)
IF $PIECE(^RMPR(665.1,DA,0),U,2)=""!($PIECE(^(0),U,3)="")!($PIECE(^(0),U,4)="")
SET DIK="^RMPR(665.1,"
DO ^DIK
WRITE !!,?5,$CHAR(7),"Deleted...",!
GOTO OP
+8 IF '$PIECE(^RMPR(665.1,DA,0),U,5)!($PIECE(^(0),U,6)="")
SET DR="4///@;4.5///@"
DO ^DIE
WRITE !!,?5,$CHAR(7),"VISIT HAS NOT BEEN CLOSED OUT"
+9 GOTO OP
CL ;CLOSE HOME/LIAISON VISITS
+1 WRITE !!
DO DIV4^RMPRSIT
if $DATA(X)
GOTO EXIT
SET DIC(0)="AEQM"
SET DIC=665.1
SET DIC("A")="Select HOME/LIAISON VISIT DATE OPENED: "
SET DIC("W")="W "" "" D DSP^RMPRHL"
SET DIC("S")="I $P(^(0),U,7)=RMPR(""STA"")"
KILL Y
DO ^DIC
if +Y'>0
GOTO EXIT
+2 SET RMPRA=+Y
LOCK +^RMPR(665.1,RMPRA,0):1
IF $TEST=0
WRITE $CHAR(7),?5,!,"Someone else is Editing this entry!"
GOTO EXIT
+3 SET DA=+Y
SET DIE=DIC
SET DR="4;I '$P(^RMPR(665.1,DA,0),U,5) S Y="""";4.5"
WRITE !
DO ^DIE
IF '$PIECE(^RMPR(665.1,DA,0),U,5)!($PIECE(^(0),U,6)="")
SET DR="4///@;4.5///@"
DO ^DIE
WRITE !!,?5,$CHAR(7),"VISIT HAS NOT BEEN CLOSED OUT"
+4 LOCK -^RMPR(665.1,RMPRA,0)
GOTO CL
ED ;EDIT/DELETE HOME/LIAISON VISITS
+1 WRITE !
DO DIV4^RMPRSIT
if $DATA(X)
GOTO EXIT
+2 SET DIC("S")="I $P(^(0),U,7)=RMPR(""STA"")"
SET DIC(0)="AEQM"
SET DIC=665.1
SET DIC("A")="Select HOME/LIAISON VISIT DATE OPENED: "
SET DIC("W")="W "" "" D DSP^RMPRHL"
DO ^DIC
if +Y'>0
GOTO EXIT
+3 SET RMPRA=+Y
LOCK +^RMPR(665.1,RMPRA,0):1
IF $TEST=0
WRITE !,$CHAR(7),?5,"Someone else is Editing this entry!"
GOTO EXIT
+4 SET DA=+Y
SET DIE=DIC
SET DR=".01;1R;2;3;5;I '$P(^RMPR(665.1,DA,0),U,5) S Y="""";4;4.5"
DO ^DIE
IF $DATA(DA)
IF '$PIECE(^RMPR(665.1,DA,0),U,5)!($PIECE(^(0),U,6)="")
SET DR="4///@;4.5///@"
DO ^DIE
+5 LOCK -^RMPR(665.1,RMPRA,0)
GOTO ED
PO ;PRINT OPEN HOME/LIAISON VISITS
+1 SET L=0
SET BY="[RMPR OPEN VISITS]"
SET DIC="^RMPR(665.1,"
SET FLDS="[RMPR OPEN VISITS]"
SET DHIT="S $P(RL,""-"",IOM)="""" W:$Y>6 RL"
SET DIOEND="I IOST[""C-"" S RX=""I $Y<21 F W ! Q:$Y>21"",DIR(0)=""E"" X RX D ^DIR"
DO EN1^DIP
GOTO EXIT
CV ;PRINT CLOSED HOME/LIAISON VISITS
+1 SET L=0
SET BY="[RMPR CLOSED VISITS]"
SET DIC="^RMPR(665.1,"
SET FLDS="[RMPR CLOSED VISITS]"
SET DHIT="S $P(RL,""-"",IOM)="""" W:$Y>6 RL"
SET DIOEND="I IOST[""C-"" S RX=""I $Y<21 F W ! Q:$Y>21"",DIR(0)=""E"" X RX D ^DIR"
DO EN1^DIP
GOTO EXIT
EXIT KILL RX,DA,RL,Y,DIC,DR,DIR,DIE,DIK,FLDS,DHIT,L,BY,RMPRSEM,RMPRA
QUIT
DSP ;DISPLAY HOME/LIAISON VISITS
+1 IF $PIECE($PIECE(^RMPR(665.1,+Y,0),";",2),U,1)="DIC(4,"
DO DSPI
QUIT
+2 IF $PIECE($PIECE(^RMPR(665.1,+Y,0),";",2),U,1)="PRC(440,"
DO DSPV
QUIT
+3 WRITE ?20,$EXTRACT($PIECE(^DPT(+$PIECE(^RMPR(665.1,+Y,0),U,2),0),U),1,20),?40," ",$SELECT($PIECE(^RMPR(665.1,+Y,0),U,3)'="":$SELECT($PIECE(^(0),U,3)["H":"HOME",1:"LIAISON"),1:""),?60
IF $PIECE(^(0),U,4)
WRITE $EXTRACT($PIECE(^VA(200,$PIECE(^(0),U,4),0),U),1,15)
QUIT
DSPI WRITE ?20,$EXTRACT($PIECE(^DIC(4,+$PIECE(^RMPR(665.1,+Y,0),U,2),0),U),1,20),?40," ",$SELECT($PIECE(^RMPR(665.1,+Y,0),U,3)'="":$SELECT($PIECE(^(0),U,3)["H":"HOME",1:"LIAISON"),1:""),?60
IF $PIECE(^(0),U,4)
WRITE $EXTRACT($PIECE(^VA(200,$PIECE(^(0),U,4),0),U),1,15)
QUIT
DSPV WRITE ?20,$EXTRACT($PIECE(^PRC(440,+$PIECE(^RMPR(665.1,+Y,0),U,2),0),U),1,20),?40," ",$SELECT($PIECE(^RMPR(665.1,+Y,0),U,3)'="":$SELECT($PIECE(^(0),U,3)["H":"HOME",1:"LIAISON"),1:""),?60
IF $PIECE(^(0),U,4)
WRITE $EXTRACT($PIECE(^VA(200,$PIECE(^(0),U,4),0),U),1,15)
QUIT
TRS ;INPUT TRANSFORM FOR TOTAL HOURS
+1 ;Hours field, under Technician mult., in file 664.3
+2 IF +X'=X!(X>999)!(X<0)!(X?.E1"."3N.N)
KILL X
QUIT
+3 IF $PIECE(X,".",2)=""
QUIT
+4 IF $PIECE(X,".",2)="5"
QUIT
+5 IF $PIECE(X,".",2)="75"
QUIT
+6 IF $PIECE(X,".",2)="25"
QUIT
+7 KILL X
QUIT
+8 ;END
