source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPTFM7.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: 4.1 KB
Line 
1DGPTFM7 ;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 ;
4EN ; 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
12BYPASS S (DGC,DGLDT)=0
13LOOP ;
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 ;
29HELP ; -- 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 ;
37KILL ; -- 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 ;
41HEADER ;
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 ;
49PRT ; -- 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 ;
77INQ ; -- 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
84DT 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 ;
Note: See TracBrowser for help on using the repository browser.