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

DGPTOM1.m

Go to the documentation of this file.
  1. DGPTOM1 ;ALB/AS - PTF MEANS TEST INDICATOR OF 'U' REPORT ; 19 MAR 87 14:00
  1. ;;5.3;Registration;;Aug 13, 1993
  1. S IOP="HOME" D ^%ZIS K IOP D LO^DGUTL,Q,ASK G:DGQ Q
  1. S DGPGM="^DGPTOM2",DGVAR="DUZ^DGD^DGP^DGSD^DGED" D ZIS^DGUTQ G:POP Q U IO S X=132 X ^%ZOSF("RM") D ^DGPTOM2,CLOSE^DGUTQ G Q
  1. RD S X="" R X:DTIME I X["^"!('$T) S DGQ=1 Q
  1. S X=$E(X) Q
  1. ASK S DGQ="" W !!,"Choose DATE RANGE by ",!?4,"(D)ISCHARGE DATE or (A)DMISSION DATE: DISCHARGE// " S Z="^DISCHARGE DATE^ADMISSION DATE" D RD Q:DGQ I X="" S X="D" W X
  1. D IN^DGHELP I %=-1 W !!?12,"CHOOSE FROM:",!?12,"A - to choose beginning and ending report dates by admission dates",!?12,"or",!?12,"D - to choose by discharge dates",! S %="" G ASK
  1. S DGD=$S(X="D":1,1:0)
  1. ;
  1. DT W ! S %DT="AEXP",%DT(0)=-DT,%DT("A")="Start with "_$S(DGD:"DISCHARGE",1:"ADMISSION")_" DATE: " D ^%DT K %DT S:X["^" DGQ=1 Q:DGQ G:Y<0 DT
  1. S %DT(0)=Y,DGSD=Y-.1,%DT="AEXP",%DT("A")=" End with "_$S(DGD:"DISCHARGE",1:"ADMISSION")_" DATE: " D ^%DT K %DT S:X["^" DGQ=1 Q:DGQ G:Y<0 DT
  1. I (DGSD+10000)<Y W !,*7,?12,"Please limit your date range to no more than 1 year." G DT
  1. S DGED=Y_.9
  1. ;
  1. P W !!,"Sort by (P)ATIENT NAME or (T)ERMINAL DIGIT ORDER: PATIENT// " S Z="^PATIENT NAME^TERMINAL DIGIT ORDER" D RD Q:DGQ I X="" S X="P" W X
  1. D IN^DGHELP I %=-1 W !!?12,"CHOOSE FROM:",!?12,"T - to have report sorted by terminal digit order or",!?12,"P - to sort by patient last name",! S %="" G P
  1. S DGP=$S(X="P":1,1:0)
  1. W !!,"You have selected output for: ",!?4,"Patients ",$S(DGD:"discharged",1:"admitted")," between "
  1. S Y=(DGSD+.1) X ^DD("DD") W ?4,Y," and " S Y=$P(DGED,".") X ^DD("DD") W Y,"."
  1. W !?4,"Report to be sorted by ",$S(DGP:"patient last name.",1:"terminal digit order."),!
  1. OK W "IS THIS CORRECT:" S %=1 D YN^DICN I '% W !!?6,"Enter <RET> if this information is correct",!?10,"Enter 'N' for NO to exit",!! G OK
  1. S:%'=1 DGQ=1 Q
  1. Q K DGD,DGP,DGSD,DGED,DGPGM,DGVAR,DGQ,POP,X,Y,Z,%,%DT Q