source: WorldVistAEHR/trunk/r/BAR_CODE_MED_ADMIN-ALPB-PSB/PSBOPF.m@ 1800

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

initial load of WorldVistAEHR

File size: 2.6 KB
RevLine 
[613]1PSBOPF ;BIRMINGHAM/TEJ-BCMA PATIENT RECORD FLAG REPORT ;Mar 2004
2 ;;3.0;BAR CODE MED ADMIN;**4**;Mar 2004
3 ;
4 ; Reference/IA
5 ; $$GETACT^DGPFAPI/3860
6 ;
7EN ;
8 N PSBHDR
9 S PSBGBL="^TMP(""PSBO"",$J,""B"")"
10 F S PSBGBL=$Q(@PSBGBL) Q:PSBGBL="" Q:$QS(PSBGBL,2)'=$J Q:$QS(PSBGBL,1)'["PSBO" D
11 .S (PSBDFN,DFN)=$QS(PSBGBL,5)
12 I '$G(PSBDFN) W !,("Error: No Patient IEN") Q
13 S PSBAUDF=$P(PSBRPT(.2),U,9)
14 S PSBHDR(0)="Patient Record Flag Report"
15 S PSBHDR(1)="Log Type: INDIVIDUAL PATIENT"
16 S PSBDFN=+$P(PSBRPT(.1),U,2)
17 W $$PTHDR(),!
18 ; GETACT - Create the flag array
19 D PATFLG(PSBDFN)
20 I '$D(PSBPTFLG) W !!?10,"<<<< NO ACTIVE PATIENT RECORD FLAG FOR THIS PATIENT >>>>",!! Q
21 ; Create the report.
22 S PSBHDR(1)="Continuing Patient Record Flag Report",PSBCONT=1
23 S PSBHDR(2)="Log Type: INDIVIDUAL PATIENT"
24 D FLGRPT
25 W !!,$$PTFTR^PSBOHDR()
26 Q
27 ;
28FLGRPT ; Displays $$GETACT^DGPFAPI data.
29 ;
30 ;
31 S (PSBIDX,PSBIX,PSBCNT)=0
32 F S PSBIDX=$O(PSBROOT(PSBIDX)) Q:+PSBIDX'>0 D
33 .W:PSBIDX>1 !,$TR($J("",IOM)," ","-"),!
34 .W !,"Flag Name: "_$P($G(PSBROOT(PSBIDX,"FLAG")),U,2)
35 .I $Y>(IOSL-12) W $$PTFTR^PSBOHDR(),$$PTHDR()
36 .W !,"Flag Type: "_$P($G(PSBROOT(PSBIDX,"FLAGTYPE")),U,2)
37 .I $Y>(IOSL-12) W $$PTFTR^PSBOHDR(),$$PTHDR()
38 .W !,"Flag Category: "_$P($G(PSBROOT(PSBIDX,"CATEGORY")),U,2)
39 .I $Y>(IOSL-12) W $$PTFTR^PSBOHDR(),$$PTHDR()
40 .W !,"Assignment Status: "_"Active"
41 .I $Y>(IOSL-12) W $$PTFTR^PSBOHDR(),$$PTHDR()
42 .W !,"Initial Assigned Date: "_$P($G(PSBROOT(PSBIDX,"ASSIGNDT")),U,2)
43 .I $Y>(IOSL-12) W $$PTFTR^PSBOHDR(),$$PTHDR()
44 .W !,"Approved by: "_$P($G(PSBROOT(PSBIDX,"APPRVBY")),U,2)
45 .I $Y>(IOSL-12) W $$PTFTR^PSBOHDR(),$$PTHDR()
46 .W !,"Next Review Date: "_$P($G(PSBROOT(PSBIDX,"REVIEWDT")),U,2)
47 .I $Y>(IOSL-12) W $$PTFTR^PSBOHDR(),$$PTHDR()
48 .W !,"Owner Site: "_$P($G(PSBROOT(PSBIDX,"OWNER")),U,2)
49 .I $Y>(IOSL-12) W $$PTFTR^PSBOHDR(),$$PTHDR()
50 .W !,"Originating Site: "_$P($G(PSBROOT(PSBIDX,"ORIGSITE")),U,2)
51 .I $Y>(IOSL-12) W $$PTFTR^PSBOHDR(),$$PTHDR()
52 .I '$D(PSBROOT(PSBIDX,"NARR")) D Q
53 ..I $Y>(IOSL-12) W $$PTFTR^PSBOHDR(),$$PTHDR()
54 .W !!,"Assignment Narratives: "
55 .I $Y>(IOSL-12) W $$PTFTR^PSBOHDR(),$$PTHDR()
56 .F S PSBIX=$O(PSBROOT(PSBIDX,"NARR",PSBIX)) Q:'PSBIX D
57 ..W !,$$WRAP^PSBO(5,60,$G(PSBROOT(PSBIDX,"NARR",PSBIX,0)))
58 ..I $Y>(IOSL-12) W $$PTFTR^PSBOHDR(),$$PTHDR()
59 .W !!,"*End of Flag Narrative*"
60 .I $Y>(IOSL-12) W $$PTFTR^PSBOHDR(),$$PTHDR()
61 K PSBROOT
62 Q
63 ;
64PATFLG(PSBDFN) ; Create PATient FLaG data.
65 N PSBIDX,PSBIX,PSBCNT
66 S PSBIDX=$$GETACT^DGPFAPI(PSBDFN,.PSBPTFLG)
67 Q:'$D(PSBPTFLG)
68 M PSBROOT=@PSBPTFLG
69 Q
70 ;
71PTHDR() ;
72 D PT^PSBOHDR(DFN,.PSBHDR)
73 Q ""
74 ;
Note: See TracBrowser for help on using the repository browser.