Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGPTFM7

DGPTFM7.m

Go to the documentation of this file.
  1. DGPTFM7 ;ALB/MJ/PLT - Display Phys. MPCR mvts ; 11/30/06 8:31am
  1. ;;5.3;Registration;**78,590,594,683,729,884**;Aug 13, 1993;Build 31
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. EN ; entry pt to display MPCR screen
  1. ; -- PTF and DGPTFMT must be defined
  1. ;
  1. S DGMAX=7,DGPTIFN=PTF,DGTOT=0 G BYPASS:DGPTFMT<2
  1. D FDT^DGPTUTL S DGFMTDT=Y
  1. 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
  1. S P=$S('$D(^DGPT(DGPTIFN,0)):DGFMTDT+1,$P(^(0),U,2)>DGFMTDT:$P(^(0),U,2),1:DGFMTDT)
  1. 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
  1. BYPASS S (DGC,DGLDT)=0
  1. LOOP ;
  1. D HEADER:$Y>(IOSL-15) S DGLAST("DT")=DGLDT,DGLAST("C")=DGC
  1. I DGPTFMT<2 W !!," MPCR information not required for this admission."
  1. 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)
  1. I DGPR D KILL Q
  1. W:DGC<DGTOT !,"...more movements available"
  1. F I=$Y:1:18 W !
  1. ;
  1. K X S $P(X,"-",81)="" W X
  1. I $D(DGBRCH) G @DGBRCH
  1. 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=""
  1. I X="^" D KILL G Q^DGPTF
  1. I X="",DGC<DGTOT G LOOP
  1. S:X="" X="^MAS"
  1. I X?1"^".E D KILL S DGPTSCRN="CDR" G ^DGPTFJ
  1. ;
  1. HELP ; -- screen help
  1. I DGC<DGTOT W !,"Press return to see more MPCR information"
  1. I DGC'<DGTOT W !,"Press return to go to the 'MAS' screen"
  1. W !," '^' to stop the display"
  1. W !," '^N' to jump to screen #N (appears in upper right of screen '<N>')"
  1. R !!,"Enter <RET>: ",X:DTIME
  1. S DGC=DGLAST("C"),DGLDT=DGLAST("DT") G LOOP
  1. ;
  1. KILL ; -- kill off locals
  1. 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
  1. Q
  1. ;
  1. I DGPR D HEAD^DGPTFMO
  1. I 'DGPR W @IOF,HEAD,?72 S Z="<MPCR>" D Z^DGPTFM
  1. W !?23,"Rec",?38,"Losing Ward",?54,"PTF"
  1. W !?4,"Losing Date",?23,"Type",?28,"Ward/DRG",?38,"MPCR/Spec",?54,"MPCR/Spec",?68,"Lve/Pas/ Los"
  1. W !,"--------------------------------------------------------------------------------"
  1. Q
  1. ;
  1. PRT ; -- collect 501 and 535 data and then print
  1. ;
  1. 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:"")
  1. ;
  1. 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=""
  1. ;
  1. 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)
  1. S DGC=DGC+1,DGLVE=$J($P(Z,U,3),3),DGPASS=$J($P(Z,U,4),3)
  1. S Y=DGLDT X ^DD("DD") S DGLDTE=Y
  1. ;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)
  1. ;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)
  1. I $D(^DIC(42.4,+$P(DGM0,U,2),0)) D
  1. . S DGMSP=$P(^DIC(42.4,+$P(DGM0,U,2),0),"^",2)
  1. . I DGMSP="" S DGMSP=$P(^DIC(42.4,+$P(DGM0,U,2),0),"^")
  1. . S DGMSP=$E(DGMSP,1,14)
  1. E S DGMSP="UNKNOWN"
  1. S DGMCDR=$J(+$P(DGM0,U,16),7,2)
  1. I $D(^DIC(42.4,+$P(DGCDR0,U,2),0)) D
  1. . S DG5SP=$P(^DIC(42.4,+$P(DGCDR0,U,2),0),"^",2)
  1. . I DG5SP="" S DG5SP=$P(^DIC(42.4,+$P(DGCDR0,U,2),0),"^")
  1. . S DG5SP=$E(DG5SP,1,14)
  1. E S DG5SP="UNKNOWN"
  1. S DG5CDR=$J(+$P(DGCDR0,U,16),7,2)
  1. S DGWARD=$E($S($D(^DIC(42,+$P(DGCDR0,U,6),0)):$P(^(0),U),1:"UNKNOWN"),1,8)
  1. ;
  1. W !,$J(DGC,3),?4,DGLDTE,?23,DGMTY,?28,DGWARD,?38,DG5CDR,?54,DGMCDR,?68,DGLVE,"/",DGPASS,"/",DGLOS,!?28,DGMDRG,?38,DG5SP,?54,DGMSP
  1. Q
  1. ;
  1. INQ ; -- entry point for inquire option
  1. ;
  1. S:'$D(DC) DC=0 S PTF=D0,DGPR=1 D EN,KILL K PTF Q:$Y<(IOSL-15)
  1. I $E(IOST,1)="C" W *7 R X:DTIME I X=U S DN=0 Q
  1. W @IOF,! X:$D(^UTILITY($J,2)) ^(2) W ! F %=1:1:IOM W "_"
  1. W !,"("_$P(^DPT(+^DGPT(D0,0),0),U,1)_")",!
  1. Q
  1. 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)
  1. Q
  1. ;