source: WorldVistAEHR/trunk/r/PROSTHETICS-RMPR-RMPO-RMPS/RMPRHL.m@ 1259

Last change on this file since 1259 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.7 KB
Line 
1RMPRHL ;PHX/JLT-ENTER/EDIT/PRINT HOME LIAISON VISITS ;8/29/1994
2 ;;3.0;PROSTHETICS;;Feb 09, 1996
3OP ;OPEN HOME/LIAISON VISITS
4 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
5 K D0,DD,DO D FILE^DICN K DLAYGO G:+Y'>0 OP
6 K DIR S (RMPRA,DA)=+Y,DIE=DIC,RMPRSEM=";"
7 L +^RMPR(665.1,RMPRA,0):1 I $T=0 W $C(7),?5,!,"Someone else is editing this record" G EXIT
8 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;"
9 S DR=DR_"@3;4;I '$P(^RMPR(665.1,DA,0),U,5) S Y="""";4.5"
10 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
11 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"
12 G OP
13CL ;CLOSE HOME/LIAISON VISITS
14 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
15 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
16 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"
17 L -^RMPR(665.1,RMPRA,0) G CL
18ED ;EDIT/DELETE HOME/LIAISON VISITS
19 W ! D DIV4^RMPRSIT G:$D(X) EXIT
20 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
21 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
22 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
23 L -^RMPR(665.1,RMPRA,0) G ED
24PO ;PRINT OPEN HOME/LIAISON VISITS
25 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
26CV ;PRINT CLOSED HOME/LIAISON VISITS
27 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
28EXIT K RX,DA,RL,Y,DIC,DR,DIR,DIE,DIK,FLDS,DHIT,L,BY,RMPRSEM,RMPRA Q
29DSP ;DISPLAY HOME/LIAISON VISITS
30 I $P($P(^RMPR(665.1,+Y,0),";",2),U,1)="DIC(4," D DSPI Q
31 I $P($P(^RMPR(665.1,+Y,0),";",2),U,1)="PRC(440," D DSPV Q
32 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
33DSPI 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
34DSPV 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
35TRS ;INPUT TRANSFORM FOR TOTAL HOURS
36 ;Hours field, under Technician mult., in file 664.3
37 I +X'=X!(X>999)!(X<0)!(X?.E1"."3N.N) K X Q
38 I $P(X,".",2)="" Q
39 I $P(X,".",2)="5" Q
40 I $P(X,".",2)="75" Q
41 I $P(X,".",2)="25" Q
42 K X Q
43 ;END
Note: See TracBrowser for help on using the repository browser.