| [613] | 1 | DGPTFM7 ;ALB/MJK - Display Phys. MPCR mvts ; 11/30/06 8:31am
|
|---|
| 2 | ;;5.3;Registration;**78,590,594,683,729**;Aug 13, 1993;Build 59
|
|---|
| 3 | ;
|
|---|
| 4 | EN ; entry pt to display MPCR screen
|
|---|
| 5 | ; -- PTF and DGPTFMT must be defined
|
|---|
| 6 | ;
|
|---|
| 7 | S DGMAX=7,DGPTIFN=PTF,DGTOT=0 G BYPASS:DGPTFMT<2
|
|---|
| 8 | D FDT^DGPTUTL S DGFMTDT=Y
|
|---|
| 9 | F NODE=535,"M" F I=0:0 S I=$O(^DGPT(DGPTIFN,NODE,I)) Q:'I I $D(^(I,0)) S Y=$S($P(^(0),U,10):$P(^(0),U,10),1:DT+.2359),^UTILITY($J,"DGCDR",Y)=NODE_U_I,^UTILITY($J,"DG"_NODE,Y)=I
|
|---|
| 10 | S P=$S('$D(^DGPT(DGPTIFN,0)):DGFMTDT+1,$P(^(0),U,2)>DGFMTDT:$P(^(0),U,2),1:DGFMTDT)
|
|---|
| 11 | F I=0:0 S I=$O(^UTILITY($J,"DGCDR",I)) Q:'I I I>DGFMTDT S DGTOT=DGTOT+1,^(I)=^(I)_"^"_P,P=I
|
|---|
| 12 | BYPASS S (DGC,DGLDT)=0
|
|---|
| 13 | LOOP ;
|
|---|
| 14 | D HEADER:$Y>(IOSL-15) S DGLAST("DT")=DGLDT,DGLAST("C")=DGC
|
|---|
| 15 | I DGPTFMT<2 W !!," MPCR information not required for this admission."
|
|---|
| 16 | F DGLDT=DGLDT:0 S DGLDT=$O(^UTILITY($J,"DGCDR",DGLDT)) Q:'DGLDT I DGLDT>DGFMTDT S X=^(DGLDT) D PRT I 'DGPR Q:'(DGC#DGMAX)!(DGC=DGTOT)
|
|---|
| 17 | I DGPR D KILL Q
|
|---|
| 18 | W:DGC<DGTOT !,"...more movements available"
|
|---|
| 19 | F I=$Y:1:18 W !
|
|---|
| 20 | ;
|
|---|
| 21 | K X S $P(X,"-",81)="" W X
|
|---|
| 22 | I $D(DGBRCH) G @DGBRCH
|
|---|
| 23 | W !,"Enter <RET> to ",$S(DGC'<DGTOT:"go to MAS screen",1:"display more MPCR information"),!," '^N' to go to screen N, or '^' to abort: <",$S(DGC'<DGTOT:"MAS",1:"RET"),">// " R X:DTIME S:'$T X="^",DGPTOUT=""
|
|---|
| 24 | I X="^" D KILL G Q^DGPTF
|
|---|
| 25 | I X="",DGC<DGTOT G LOOP
|
|---|
| 26 | S:X="" X="^MAS"
|
|---|
| 27 | I X?1"^".E D KILL S DGPTSCRN="CDR" G ^DGPTFJ
|
|---|
| 28 | ;
|
|---|
| 29 | HELP ; -- screen help
|
|---|
| 30 | I DGC<DGTOT W !,"Press return to see more MPCR information"
|
|---|
| 31 | I DGC'<DGTOT W !,"Press return to go to the 'MAS' screen"
|
|---|
| 32 | W !," '^' to stop the display"
|
|---|
| 33 | W !," '^N' to jump to screen #N (appears in upper right of screen '<N>')"
|
|---|
| 34 | R !!,"Enter <RET>: ",X:DTIME
|
|---|
| 35 | S DGC=DGLAST("C"),DGLDT=DGLAST("DT") G LOOP
|
|---|
| 36 | ;
|
|---|
| 37 | KILL ; -- kill off locals
|
|---|
| 38 | K ^UTILITY($J,"DGCDR"),^("DG535"),^("DGM"),DGCDR,DGC,DGI0,DGICDR,DGLDT,DGLVE,DGPASS,DG5SP,DG5CDR,DGMSP,DGMCDR,DGMDRG,DGMAX,DGTOT,DGWARD,DGPTIFN,DGLAST,DGFMTDT,DGLDTE,DGCDR0,DGM0,DGMTY,P,I
|
|---|
| 39 | Q
|
|---|
| 40 | ;
|
|---|
| 41 | HEADER ;
|
|---|
| 42 | I DGPR D HEAD^DGPTFMO
|
|---|
| 43 | I 'DGPR W @IOF,HEAD,?72 S Z="<MPCR>" D Z^DGPTFM
|
|---|
| 44 | W !?23,"Rec",?38,"Losing Ward",?54,"PTF"
|
|---|
| 45 | W !?4,"Losing Date",?23,"Type",?28,"Ward/DRG",?38,"MPCR/Spec",?54,"MPCR/Spec",?68,"Lve/Pas/ Los"
|
|---|
| 46 | W !,"--------------------------------------------------------------------------------"
|
|---|
| 47 | Q
|
|---|
| 48 | ;
|
|---|
| 49 | PRT ; -- collect 501 and 535 data and then print
|
|---|
| 50 | ;
|
|---|
| 51 | I $P(X,U)="M" S DGMTY=501,(Z,DGM0)=^DGPT(DGPTIFN,"M",+$P(X,U,2),0),DGMDRG=$S($D(^("P")):$P(^("P"),U),1:""),Y=+$O(^UTILITY($J,"DG535",DGLDT-.0000001)),DGCDR0=$S('$D(^(Y)):"",$D(^DGPT(DGPTIFN,535,+^(Y),0)):^(0),1:"")
|
|---|
| 52 | ;
|
|---|
| 53 | I $P(X,U)="535" S DGMTY=535,(Z,DGCDR0)=^DGPT(DGPTIFN,535,+$P(X,U,2),0),Y=+$O(^UTILITY($J,"DGM",DGLDT-.0000001)),DGM0=$S('$D(^(Y)):"",$D(^DGPT(DGPTIFN,"M",+^(Y),0)):^(0),1:""),DGMDRG=""
|
|---|
| 54 | ;
|
|---|
| 55 | N DGLOS S X1=DGLDT,X2=$P(X,U,3) D ^%DTC S X=X-$P(Z,U,3),DGLOS=$J($S(X>0:X,1:1),4)
|
|---|
| 56 | S DGC=DGC+1,DGLVE=$J($P(Z,U,3),3),DGPASS=$J($P(Z,U,4),3)
|
|---|
| 57 | S Y=DGLDT X ^DD("DD") S DGLDTE=Y
|
|---|
| 58 | ;S DGMSP=$E($S($D(^DIC(42.4,+$P(DGM0,U,2),0)):$P(^(0),U),1:"UNKNOWN"),1,14),DGMCDR=$J(+$P(DGM0,U,16),7,2)
|
|---|
| 59 | ;S DG5SP=$E($S($D(^DIC(42.4,+$P(DGCDR0,U,2),0)):$P(^(0),U),1:"UNKNOWN"),1,14),DG5CDR=$J(+$P(DGCDR0,U,16),7,2)
|
|---|
| 60 | I $D(^DIC(42.4,+$P(DGM0,U,2),0)) D
|
|---|
| 61 | . S DGMSP=$P(^DIC(42.4,+$P(DGM0,U,2),0),"^",2)
|
|---|
| 62 | . I DGMSP="" S DGMSP=$P(^DIC(42.4,+$P(DGM0,U,2),0),"^")
|
|---|
| 63 | . S DGMSP=$E(DGMSP,1,14)
|
|---|
| 64 | E S DGMSP="UNKNOWN"
|
|---|
| 65 | S DGMCDR=$J(+$P(DGM0,U,16),7,2)
|
|---|
| 66 | I $D(^DIC(42.4,+$P(DGCDR0,U,2),0)) D
|
|---|
| 67 | . S DG5SP=$P(^DIC(42.4,+$P(DGCDR0,U,2),0),"^",2)
|
|---|
| 68 | . I DG5SP="" S DG5SP=$P(^DIC(42.4,+$P(DGCDR0,U,2),0),"^")
|
|---|
| 69 | . S DGMSP=$E(DGMSP,1,14)
|
|---|
| 70 | E S DG5SP="UNKNOWN"
|
|---|
| 71 | S DG5CDR=$J(+$P(DGCDR0,U,16),7,2)
|
|---|
| 72 | S DGWARD=$E($S($D(^DIC(42,+$P(DGCDR0,U,6),0)):$P(^(0),U),1:"UNKNOWN"),1,8)
|
|---|
| 73 | ;
|
|---|
| 74 | W !,$J(DGC,3),?4,DGLDTE,?23,DGMTY,?28,DGWARD,?38,DG5CDR,?54,DGMCDR,?68,DGLVE,"/",DGPASS,"/",DGLOS,!?28,DGMDRG,?38,DG5SP,?54,DGMSP
|
|---|
| 75 | Q
|
|---|
| 76 | ;
|
|---|
| 77 | INQ ; -- entry point for inquire option
|
|---|
| 78 | ;
|
|---|
| 79 | S:'$D(DC) DC=0 S PTF=D0,DGPR=1 D EN,KILL K PTF Q:$Y<(IOSL-15)
|
|---|
| 80 | I $E(IOST,1)="C" W *7 R X:DTIME I X=U S DN=0 Q
|
|---|
| 81 | W @IOF,! X:$D(^UTILITY($J,2)) ^(2) W ! F %=1:1:IOM W "_"
|
|---|
| 82 | W !,"("_$P(^DPT(+^DGPT(D0,0),0),U,1)_")",!
|
|---|
| 83 | Q
|
|---|
| 84 | DT I Y W $P("JAN^FEB^MAR^APR^MAY^JUN^JUL^AUG^SEP^OCT^NOV^DEC",U,$E(Y,4,5))," " W:Y#100 $J(Y#100\1,2),"," W Y\10000+1700 W:Y#1 " ",$E(Y_0,9,10),":",$E(Y_"000",11,12)
|
|---|
| 85 | Q
|
|---|
| 86 | ;
|
|---|
