95 lines
5.5 KiB
Mathematica
95 lines
5.5 KiB
Mathematica
RMPR29I ;PHX/JLT-PRINT PENDING/CLOSED/ASSIGNED [ 10/18/94 1:34 PM ]
|
|
;;3.0;PROSTHETICS;;Feb 09, 1996
|
|
PC ;REPORT 2529-3 PENDING COMPLETION
|
|
K QUIT D ST^RMPRDT G:$D(QUIT) EXIT
|
|
S DIC="^RMPR(664.1,",BY="@.01",FR=DATE(1),TO=DATE(2)
|
|
;Screen DIS(0)
|
|
;if not DATE DELIVERED
|
|
;if STATION equal to division selected
|
|
;if RECEIVING STATION not equal to division selected
|
|
;if STATUS is PC
|
|
S DIS(0)="I '$P($G(^RMPR(664.1,D0,7)),U,2),$P(^RMPR(664.1,D0,0),U,3)=RMPR(""STA""),$P(^RMPR(664.1,D0,0),U,15)'=RMPR(""STA""),$P(^RMPR(664.1,D0,0),U,17)=""PC""" D FLDS Q
|
|
PEN ;PENDING 2529-3s
|
|
;if not DATE DELIVERED
|
|
;if STATION equal to division selected
|
|
;if STATUS is P
|
|
K QUIT D ST^RMPRDT G:$D(QUIT) EXIT
|
|
S DIC="^RMPR(664.1,",BY="@.01",FR=DATE(1),TO=DATE(2)
|
|
;screen DIS(0)
|
|
S DIS(0)="I '$P($G(^RMPR(664.1,D0,7)),U,2),$P(^RMPR(664.1,D0,0),U,3)=RMPR(""STA""),$P(^RMPR(664.1,D0,0),U,17)=""P"""
|
|
FLDS ;set flds array for call to dip
|
|
S FLDS="STRIPBLANKS(PATIENT);C1;""PATIENT"",.02:.01:.09;C40;""SSN"",4;C60;""WORK ORDER"""
|
|
S FLDS(1)="REQUESTING OFFICIAL;C1;""INITIATED BY"",.01;C40;""DATE INIT"",TODAY-DATE;C60;""#DAYS"",""WORK FOR: "";C1,2;C11;X,D DIS^RMPR29I;X;C40",FLDS(2)="6,""ITEM:"";C1;X,.01;C10;X,D ADC^RMPR29I;X,""DESC:"";C1,7;C10;W60;X"
|
|
S L=0,DHD=" <PENDING 2529-3s>",DHIT="D LINE^RMPR29I" D EN1^DIP
|
|
EXIT ;common exit point
|
|
K BY,D0,D1,DATE,DHD,DHIT,DIC,DIS,FLDS,FR,LDAT,LP,PZD,QUIT,RA,RAT,RD0,RD1,RLAB,RRA,RVAR,RRRZ,SRC,TO,TYPE,X,Y,L
|
|
Q
|
|
DIS ;DISLAY DISABILITY
|
|
N RR,RD
|
|
I $D(^RMPR(664.1,D0,1)) D
|
|
.W "DIS CODE: "
|
|
.S RR=0,RD=""
|
|
.F S RR=$O(^RMPR(664.1,D0,1,RR)) Q:RR'>0 D
|
|
..S RD=$P(^RMPR(664.1,D0,1,RR,0),U,1)
|
|
..Q:RD=""
|
|
..W $P(^RMPR(662,RD,0),U)_"-"_$S($P(^RMPR(664.1,D0,1,RR,0),U,2)=1:"SC",1:"NSC") I $O(^RMPR(664.1,D0,1,RR)) W ","
|
|
;see internal notes, fix on a FM problem.
|
|
S X=""
|
|
Q
|
|
ADC ;GET AMIS CODE
|
|
D ADC^RMPR293(D0,D1) S X="" Q
|
|
LINE ;WRITE A DASHED LINE
|
|
I $Y>5 K LP S $P(LP,"-",IOM)="" W LP
|
|
Q
|
|
ASN ;ASSIGNED 2529-3s
|
|
K QUIT D ST^RMPRDT G:$D(QUIT) EXIT
|
|
S DIC="^RMPR(664.1,",BY="@.01",FR=DATE(1),TO=DATE(2),DIS(0)="I '$P($G(^RMPR(664.1,D0,7)),U,2),$P(^RMPR(664.1,D0,0),U,3)=RMPR(""STA""),$P(^RMPR(664.1,D0,0),U,17)=""A"""
|
|
S FLDS="STRIPBLANKS(PATIENT);C1;""PATIENT"",.02:.01:.09;C40;""SSN"",4;C60;""WORK ORDER"""
|
|
S FLDS(1)="REQUESTING OFFICIAL;C1;""INITIATED BY"",DATE;C40;""DATE INIT"",DATE ASSIGNED-DATE;C60;""#DAYS PENDING"";W15"
|
|
S FLDS(2)="""ASSIGNED BY:"";C1,ASSIGNED BY;C15;X,""DATE ASSIGNED"";C40,DATE ASSIGNED;X;C60"
|
|
S FLDS(3)="""WORK FOR: "";C1,2;C11;X,""ASSIGNED TO:"";C40,STRIPBLANKS(TECHNICIAN);C60;X"
|
|
S FLDS(4)="D DIS^RMPR29I;C1;X"
|
|
S FLDS(5)="6,""ITEM:"";C1;X,.01;C10;X,D LEW^RMPR29I;C40;X,D STN^RMPR29I;X,D ADC^RMPR29I;X,""DESC:"";C1,7;C10;W60;X"
|
|
S FLDS(6)="6,""LABOR COST:"";X;C1,5:STRIPBLANKS(TOTAL LABOR COST);X;C15,""MATERIAL COST:"";X;C24,5:STRIPBLANKS(TOTAL MATERIAL COST);X;C40,""TOTAL COST:"";X;C50,5:STRIPBLANKS(TOTAL LAB COST);X;C65"
|
|
S DHD=" <ASSIGNED/OPEN 2529-3s>",DHIT="D LINE^RMPR29I" D EN1^DIP
|
|
D EXIT Q
|
|
LEW ;GET LAST WORK DATE ENTRY
|
|
N Y
|
|
K RVAR S LDAT(2)=0,RAT=$P($G(^RMPR(664.1,D0,2,D1,0)),U,5)
|
|
I +RAT F RA=0:0 S RA=$O(^RMPR(664.3,"C",RAT,RA)) Q:RA'>0 S RVAR=RA D
|
|
.I $D(RVAR) S LDAT(1)=$P($G(^RMPR(664.3,RVAR,0)),U) I LDAT(1)>LDAT(2) S LDAT(2)=LDAT(1)
|
|
I LDAT(2)=0 W "LAST WORK DATE: " Q
|
|
S Y=LDAT(2) D DD^%DT W "LAST WORK DATE: "_Y
|
|
S X=""
|
|
Q
|
|
STN ;GET STATUS OF PROCUREMENT
|
|
S RAT=$P($G(^RMPR(664.1,D0,2,D1,0)),U,6) I +RAT F RA=0:0 S RA=$O(^RMPR(664.2,+RAT,1,RA)) Q:RA'>0 S RRA=(^(RA,0)) D
|
|
.I $D(^RMPR(664,+$P(RRA,U,11),0)),'$P(^(0),U,8) W !,?9,"2421 PURCHASE "_$P(RRA,U,10)_" PENDING DELIVERY"
|
|
.I $D(^RMPR(664.1,+$P(RRA,U,13),0)),'$P(^(0),U,26) W !,?9,"2529-3 REQUEST "_$P(RRA,U,10)_" PENDING DELIVERY"
|
|
S X=""
|
|
Q
|
|
OCLS ;DISPLAY CLOSED REMOTE 2529-3
|
|
K QUIT D ST^RMPRDT G:$D(QUIT) EXIT
|
|
S DIC="^RMPR(664.1,",BY="@20",FR=DATE(1),TO=DATE(2),DIS(0)="I $P($G(^RMPR(664.1,D0,7)),U,2),$P(^RMPR(664.1,D0,0),U,3)=RMPR(""STA""),$P(^RMPR(664.1,D0,0),U,15)'=RMPR(""STA""),$P(^RMPR(664.1,D0,0),U,17)=""C""" D FLDSC Q
|
|
CLS ;CLOSED 2529-3s
|
|
K QUIT D ST^RMPRDT G:$D(QUIT) EXIT
|
|
S L=0
|
|
S DIC="^RMPR(664.1,",BY="@20",FR=DATE(1),TO=DATE(2),DIS(0)="I $P($G(^RMPR(664.1,D0,7)),U,2),$P(^RMPR(664.1,D0,0),U,3)=RMPR(""STA""),$P(^RMPR(664.1,D0,0),U,15)=RMPR(""STA""),$P(^RMPR(664.1,D0,0),U,17)=""C"""
|
|
S FLDS="STRIPBLANKS(PATIENT);C1;""PATIENT"",.02:.01:.09;C40;""SSN"",4;C60;""WORK ORDER"""
|
|
S FLDS(1)="REQUESTING OFFICIAL;C1;""INITIATED BY"",DATE;C40;""DATE INIT"",DATE DELIVERED-DATE;C60;""#DAYS OPEN"";W15"
|
|
S FLDS(2)="""ASSIGNED BY:"";C1,ASSIGNED BY;C15;X,""DATE ASSIGNED"";C40,DATE ASSIGNED;X;C60"
|
|
S FLDS(3)="""WORK FOR: "";C1,2;C11;X,""ASSIGNED TO:"";C40,STRIPBLANKS(TECHNICIAN);C60;X"
|
|
S FLDS(4)="D DIS^RMPR29I;C1;X"
|
|
S FLDS(5)="6,""ITEM:"";C1;X,.01;C10;X,D LEW^RMPR29I;C40;X,D ADC^RMPR29I;X,""DESC:"";C1,7;C10;W60;X"
|
|
S FLDS(6)="6,""LABOR COST:"";X;C1,5:STRIPBLANKS(TOTAL LABOR COST);X;C15,""MATERIAL COST:"";X;C24,5:STRIPBLANKS(TOTAL MATERIAL COST);X;C40,""TOTAL COST:"";X;C50,5:STRIPBLANKS(TOTAL LAB COST);X;C65"
|
|
S FLDS(7)="""DELIVERY DATE"";C1;X,20;C15;X"
|
|
S DHD=" <CLOSED 2529-3s>",DHIT="D LINE^RMPR29I" D EN1^DIP
|
|
D EXIT Q
|
|
FLDSC ;set flds array for call to dip
|
|
S FLDS="STRIPBLANKS(PATIENT);C1;""PATIENT"",.02:.01:.09;C40;""SSN"",4;C60;""WORK ORDER"""
|
|
S FLDS(1)="REQUESTING OFFICIAL;C1;""INITIATED BY"",DATE;C40;""DATE INIT"",DATE DELIVERED-DATE;C60;""#DAYS OPEN"";W15"
|
|
S FLDS(2)="""WORK FOR: "";C1,2;C11;X,D DIS^RMPR29I;C40;X"
|
|
S FLDS(3)="6,""ITEM:"";C1;X,.01;C10,D ADC^RMPR29I;X,""DESC:"";C1,7;C10;W60;X",FLDS(4)="""DELIVERY DATE"";C1;X,20;C15;X"
|
|
S DHD=" <CLOSED 2529-3s>",DHIT="D LINE^RMPR29I" D EN1^DIP
|
|
D EXIT Q
|