source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPTFOU.m@ 1801

Last change on this file since 1801 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.7 KB
RevLine 
[613]1DGPTFOU ;ALB/JDS - PTF REPORTS ;31 MAR 87 13:00
2 ;;5.3;Registration;;Aug 13, 1993
3 ;
41 ;CODING REPORT
5 I '$D(DGRTY) S Y=1 D RTY^DGPTUTL
6 K IOP S Z="^RELEASED^CLOSED^TRANSMITTED^ALL"
7 R !,"Print which PTF Status(es):",!?2,"(R)ELEASED,(T)RANSMITTED,(C)LOSED or (A)LL: ALL// ",X:DTIME G Q:'$T!(X[U) I X="" S X="A" W X
8 D IN^DGHELP
9 I %=-1 W !!?12,"CHOOSE FROM:",!?12,"R - to include only Released records in report",!?12,"C - to include only Closed records",!?12,"T - to include only Transmitted records",!?12,"A - for All of the above",! G 1
10 S DGSTAT=X
11BY S Z="^RELEASED^TRANSMISSION^CLOSE OUT^"_$S(DGRTY=1:"DISCHARGE",1:"PTF CENSUS DATE")
12 W !!,"By ",$S(DGSTAT="R":"(R)ELEASE",DGSTAT="T":"(T)RANSMISSION",1:"(C)LOSE OUT")," or"
13 W:DGRTY=1 " (D)ISCHARGE DATE RANGE: DISCHARGE//"
14 W:DGRTY=2 " (P)TF CENSUS DATE: PTF CENSUS DATE//"
15 R X:DTIME G Q:'$T!(X[U) I X="" S X=$S(DGRTY=1:"D",1:"P") W X
16 D IN^DGHELP I %=-1 D HELP1 G BY
17 S DGSORT=X,DGSORT1="?"
18 I DGRTY=2,DGSORT="P" D CEN^DGPTUTL S:+DGCN0 DIC("B")=+DGCN0 S DIC="^DG(45.86,",DIC(0)="AEMQZ" W ! D ^DIC K DIC G Q:Y<0 S DGSORT1=+Y(0)
19 S FR=$S(DGSTAT="T":3,DGSTAT="R":2,1:1)_","_DGSORT1,TO=$S(DGSTAT="R":2,DGSTAT="C":1,1:3)_","_DGSORT1
20 S BY="+#STATUS,@"_$S(DGSORT="D"!(DGSORT="P"):"70",DGSTAT="T":7.4,DGSTAT="R":7.3,1:7.2),FLDS=$S(DGRTY=2:"[DGPT CENSUS CODING REPORT]",1:"[DGCODING REPORT]"),L=0,DIC="^DGPT("
21 S DIS(0)="I $D(^DGPT(D0,0)),$P(^(0),U,11)="_+DGRTY,DHD=$P(DGRTY0,U)_" CODING REPORT"
22 W ! D EN1^DIP,Q Q
23 ;
242 ;CODING CLERK REPORT
25 I '$D(DGRTY) S Y=1 D RTY^DGPTUTL
26 K IOP S Z="^CLOSED^RELEASED"
27 R !,"Print by [C]lose Out or [R]elease Date: C// ",X:DTIME G Q:'$T!(X[U) I X="" S X="C" W X
28 D IN^DGHELP I %=-1 W !,"ENTER:",!," 'C' to limit by range of Close out Dates",!," 'R' to limit by range of Release dates",! G 2
29 S DGSORT=X,BY="+CODING CLERK,.01,@"_$S(DGSORT="C":"7.2",1:"7.3"),FR="?,?",TO=FR,FLDS=$S(DGRTY=2:"[DGPT CENSUS CODING REPORT]",1:"[DGCODING REPORT]"),DHD=$P(DGRTY0,U)_" PRODUCTIVITY REPORT",L=0,DIC="^DGPT("
30 S DIS(0)="I $D(^DGPT(D0,0)),$P(^(0),U,11)="_+DGRTY
31 D EN1^DIP
32Q K %,%X,%Y,AD,BY,D0,DA,DC,DCC,DD0,DFN,DFN1,DFN2,DGD0,DHD,DHT,DI,DIC,DIE,DIS,DIS2,DJ,DLP,DN,DP,DR,DX,DY,FLDS,FR,I1,L,PR,PTF,TDD,TO,TY,X,Z,DGRTY,DGRTY0,DGSORT,DGSORT1,DGCN,DGCN0
33 Q
34 ;
353 ;PTF UPDATE (obsolete)
36 Q
37 ;
384 ;COMPREHENSIVE REPORT BY PATIENT
39 K IOP W !,"In PTF file sort by any field criteria",!
40 S DIC="^DGPT(",FLDS="[DGPTF]" G EN1^DIP
41HELP1 W !!?12,"CHOOSE FROM:"
42 I DGRTY=1 W !?12,"D - to select a range of discharge dates to have report sorted by"
43 I DGRTY=2 W !?12,"P - to select all census record for a specific PTF census date"
44 W !?12,$S(DGSTAT="R":"R",DGSTAT="T":"T",1:"C")," - to select a range of ",$S(DGSTAT="R":"release",DGSTAT="T":"transmission",1:"close out")
45 W " dates to sort by" Q
Note: See TracBrowser for help on using the repository browser.