source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGOASIH.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: 2.7 KB
Line 
1DGOASIH ;ALB/VAD - LIST OF PATIENTS ON ASIH ;Sep 27 1999
2 ;;5.3;Registration;**162,227**;Aug 13, 1993
3 ;
4 ; PATCH 5.3*227 ADDED SEP 27 1999 BY VAD
5 ; Rather than only allow for the entry of tomorrow's date, the
6 ; ability to enter any future date has been added. However, if
7 ; a future date is entered, then a warning message will display
8 ; stating that the report should be tasked to prevent the printing
9 ; of a negative report. Line EN3 has been split to allow for the
10 ; code for this patch to be added.
11 ;
12EN3 K TD,DGF S %DT="AEXPT",%DT("A")="Enter date of ASIH: " D ^%DT G QUIT:Y'>0
13 ; *** Start of patched code inserted for 5.3*227 - VAD.
14 I +Y>+DT D G:DGU QUIT
15 . W !!?10,$C(7),"You have entered a future date...to prevent the printing"
16 . W !?10,"of a negative report, remember to task this request for"
17 . W !?10,"the appropriate date."
18 . S DGU=0 D RT
19 ; *** End of patched code.
20 ;
21 S DGT=+Y,DGT=$S(DGT[".":DGT,1:DGT_".2400")
22 S Y=DGT X ^DD("DD") S DGDAY=$P(Y,"@") S DGHD="ASIH LIST FOR "_Y,X1=DT,X2=-30 D C^%DTC S DGPG=0
23 S DGVAR="DGT^DGPG^DGDAY^DGHD",DGPGM="START^DGOASIH" D ZIS^DGUTQ I 'POP U IO D START^DGOASIH
24QUIT K DGHD,DGST I '$D(ZTQUEUED) D CLOSE^DGUTQ
25QUIT1 K %,%I,%T,%DT,DFN,DG2,DGADM,DGCA,DGCD,DGCL,DGD,DGDAY,DGDV,DGFL,DGI,DGJ,DGLV,DGNO,DGP,DGPG,DGPGM,DGRT,DGSTART,DGT,DGTIME,DGTP,DGU,DGVAR,DGW,DGA,DGDAT,DGDFN,DGDT,DGIFN,DGNOW,DGTYP,DGX,DGY,POP,VA,VADAT,VADATE,VAERR,^UTILITY($J,"DG"),X,X1,X2,Y
26 K M,VAIP,VAIP("D") Q
27START D NOW^%DTC S Y=$E(%,1,12) S DGTIME=$$FMTE^XLFDT(Y,1) S $P(DGCL,"-",81)="",DGFL=0,X1=DGT,X2=-32 D C^%DTC S DGSTART=X
28 D NOW^%DTC S DGNOW=%
29 S DGA="^13^43^44^45^"
30 S DGDAT=DGT,DGST=0,DGPG=0
31 F DGDT=DGSTART:0 S DGDT=$O(^DGPM("AMV2",DGDT)) Q:'DGDT!(DGDT>DGDAT) F DFN=0:0 S DFN=$O(^DGPM("AMV2",DGDT,DFN)) Q:'DFN F DGIFN=0:0 S DGIFN=$O(^DGPM("AMV2",DGDT,DFN,DGIFN)) Q:'DGIFN S DGASIH=1 D CK^DGPASS Q:DGFL
32 K DGASIH I '$D(^UTILITY($J,"DG")) W !!?8,"*** THERE ARE NO PATIENTS OUT ON ASIH FOR "_DGDAY_" ***" G QUIT
33 D WR
34 G QUIT
35HEAD S DGPG=DGPG+1 W @IOF,!,DGHD,?35,"PRINTED: ",DGTIME,?72," PAGE: "_DGPG
36 W !!,"NAME",?22,"PT ID",?38,"LEFT",?54,"LOCATION"
37 W !,DGCL,!!,?10,"DIVISION: ",$S(DGDV="ZUNKNOWN":"UNKNOWN",1:DGDV),!
38 Q
39WR S (DGU,DGDV,DGFL,DGP)=0
40 F DGD=0:0 S DGDV=$O(^UTILITY($J,"DG",DGDV)) Q:DGDV=""!(DGU) S DGPG=0 D:DGFL RT Q:DGU D HEAD F M=0:0 S DGP=$O(^UTILITY($J,"DG",DGDV,DGP)) Q:DGP=""!(DGU) D WRCNT
41 W ! Q
42WRCNT F DFN=0:0 S DFN=$O(^UTILITY($J,"DG",DGDV,DGP,DFN)) Q:'DFN!(DGU) S DGNO=^UTILITY($J,"DG",DGDV,DGP,DFN) D WR1 S DGFL=1
43 Q
44WR1 I $Y+4>IOSL D:IOST?1"C-".E RT Q:DGU D HEAD
45 W !,$E(DGP,1,20),?22,$P(DGNO,"^"),?38 S X=$P(DGNO,"^",2) W X W ?54,$P(DGNO,"^",3) Q
46RT Q:IOST'?1"C-".E
47 F X=$Y:1:(IOSL-2) W !
48 R !?22,"Enter <RET> to continue or ^ to Quit",X:DTIME S:X["^"!('$T) DGU=1 Q:DGU=1
49 Q
Note: See TracBrowser for help on using the repository browser.