PSBOPF ;BIRMINGHAM/TEJ-BCMA PATIENT RECORD FLAG REPORT ;Mar 2004
;;3.0;BAR CODE MED ADMIN;**4**;Mar 2004
;
; Reference/IA
; $$GETACT^DGPFAPI/3860
;
EN ;
N PSBHDR
S PSBGBL="^TMP(""PSBO"",$J,""B"")"
F S PSBGBL=$Q(@PSBGBL) Q:PSBGBL="" Q:$QS(PSBGBL,2)'=$J Q:$QS(PSBGBL,1)'["PSBO" D
.S (PSBDFN,DFN)=$QS(PSBGBL,5)
I '$G(PSBDFN) W !,("Error: No Patient IEN") Q
S PSBAUDF=$P(PSBRPT(.2),U,9)
S PSBHDR(0)="Patient Record Flag Report"
S PSBHDR(1)="Log Type: INDIVIDUAL PATIENT"
S PSBDFN=+$P(PSBRPT(.1),U,2)
W $$PTHDR(),!
; GETACT - Create the flag array
D PATFLG(PSBDFN)
I '$D(PSBPTFLG) W !!?10,"<<<< NO ACTIVE PATIENT RECORD FLAG FOR THIS PATIENT >>>>",!! Q
; Create the report.
S PSBHDR(1)="Continuing Patient Record Flag Report",PSBCONT=1
S PSBHDR(2)="Log Type: INDIVIDUAL PATIENT"
D FLGRPT
W !!,$$PTFTR^PSBOHDR()
Q
;
FLGRPT ; Displays $$GETACT^DGPFAPI data.
;
;
S (PSBIDX,PSBIX,PSBCNT)=0
F S PSBIDX=$O(PSBROOT(PSBIDX)) Q:+PSBIDX'>0 D
.W:PSBIDX>1 !,$TR($J("",IOM)," ","-"),!
.W !,"Flag Name: "_$P($G(PSBROOT(PSBIDX,"FLAG")),U,2)
.I $Y>(IOSL-12) W $$PTFTR^PSBOHDR(),$$PTHDR()
.W !,"Flag Type: "_$P($G(PSBROOT(PSBIDX,"FLAGTYPE")),U,2)
.I $Y>(IOSL-12) W $$PTFTR^PSBOHDR(),$$PTHDR()
.W !,"Flag Category: "_$P($G(PSBROOT(PSBIDX,"CATEGORY")),U,2)
.I $Y>(IOSL-12) W $$PTFTR^PSBOHDR(),$$PTHDR()
.W !,"Assignment Status: "_"Active"
.I $Y>(IOSL-12) W $$PTFTR^PSBOHDR(),$$PTHDR()
.W !,"Initial Assigned Date: "_$P($G(PSBROOT(PSBIDX,"ASSIGNDT")),U,2)
.I $Y>(IOSL-12) W $$PTFTR^PSBOHDR(),$$PTHDR()
.W !,"Approved by: "_$P($G(PSBROOT(PSBIDX,"APPRVBY")),U,2)
.I $Y>(IOSL-12) W $$PTFTR^PSBOHDR(),$$PTHDR()
.W !,"Next Review Date: "_$P($G(PSBROOT(PSBIDX,"REVIEWDT")),U,2)
.I $Y>(IOSL-12) W $$PTFTR^PSBOHDR(),$$PTHDR()
.W !,"Owner Site: "_$P($G(PSBROOT(PSBIDX,"OWNER")),U,2)
.I $Y>(IOSL-12) W $$PTFTR^PSBOHDR(),$$PTHDR()
.W !,"Originating Site: "_$P($G(PSBROOT(PSBIDX,"ORIGSITE")),U,2)
.I $Y>(IOSL-12) W $$PTFTR^PSBOHDR(),$$PTHDR()
.I '$D(PSBROOT(PSBIDX,"NARR")) D Q
..I $Y>(IOSL-12) W $$PTFTR^PSBOHDR(),$$PTHDR()
.W !!,"Assignment Narratives: "
.I $Y>(IOSL-12) W $$PTFTR^PSBOHDR(),$$PTHDR()
.F S PSBIX=$O(PSBROOT(PSBIDX,"NARR",PSBIX)) Q:'PSBIX D
..W !,$$WRAP^PSBO(5,60,$G(PSBROOT(PSBIDX,"NARR",PSBIX,0)))
..I $Y>(IOSL-12) W $$PTFTR^PSBOHDR(),$$PTHDR()
.W !!,"*End of Flag Narrative*"
.I $Y>(IOSL-12) W $$PTFTR^PSBOHDR(),$$PTHDR()
K PSBROOT
Q
;
PATFLG(PSBDFN) ; Create PATient FLaG data.
N PSBIDX,PSBIX,PSBCNT
S PSBIDX=$$GETACT^DGPFAPI(PSBDFN,.PSBPTFLG)
Q:'$D(PSBPTFLG)
M PSBROOT=@PSBPTFLG
Q
;
PTHDR() ;
D PT^PSBOHDR(DFN,.PSBHDR)
Q ""
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSBOPF 2754 printed Dec 13, 2024@01:40:49 Page 2
PSBOPF ;BIRMINGHAM/TEJ-BCMA PATIENT RECORD FLAG REPORT ;Mar 2004
+1 ;;3.0;BAR CODE MED ADMIN;**4**;Mar 2004
+2 ;
+3 ; Reference/IA
+4 ; $$GETACT^DGPFAPI/3860
+5 ;
EN ;
+1 NEW PSBHDR
+2 SET PSBGBL="^TMP(""PSBO"",$J,""B"")"
+3 FOR
SET PSBGBL=$QUERY(@PSBGBL)
if PSBGBL=""
QUIT
if $QSUBSCRIPT(PSBGBL,2)'=$JOB
QUIT
if $QSUBSCRIPT(PSBGBL,1)'["PSBO"
QUIT
Begin DoDot:1
+4 SET (PSBDFN,DFN)=$QSUBSCRIPT(PSBGBL,5)
End DoDot:1
+5 IF '$GET(PSBDFN)
WRITE !,("Error: No Patient IEN")
QUIT
+6 SET PSBAUDF=$PIECE(PSBRPT(.2),U,9)
+7 SET PSBHDR(0)="Patient Record Flag Report"
+8 SET PSBHDR(1)="Log Type: INDIVIDUAL PATIENT"
+9 SET PSBDFN=+$PIECE(PSBRPT(.1),U,2)
+10 WRITE $$PTHDR(),!
+11 ; GETACT - Create the flag array
+12 DO PATFLG(PSBDFN)
+13 IF '$DATA(PSBPTFLG)
WRITE !!?10,"<<<< NO ACTIVE PATIENT RECORD FLAG FOR THIS PATIENT >>>>",!!
QUIT
+14 ; Create the report.
+15 SET PSBHDR(1)="Continuing Patient Record Flag Report"
SET PSBCONT=1
+16 SET PSBHDR(2)="Log Type: INDIVIDUAL PATIENT"
+17 DO FLGRPT
+18 WRITE !!,$$PTFTR^PSBOHDR()
+19 QUIT
+20 ;
FLGRPT ; Displays $$GETACT^DGPFAPI data.
+1 ;
+2 ;
+3 SET (PSBIDX,PSBIX,PSBCNT)=0
+4 FOR
SET PSBIDX=$ORDER(PSBROOT(PSBIDX))
if +PSBIDX'>0
QUIT
Begin DoDot:1
+5 if PSBIDX>1
WRITE !,$TRANSLATE($JUSTIFY("",IOM)," ","-"),!
+6 WRITE !,"Flag Name: "_$PIECE($GET(PSBROOT(PSBIDX,"FLAG")),U,2)
+7 IF $Y>(IOSL-12)
WRITE $$PTFTR^PSBOHDR(),$$PTHDR()
+8 WRITE !,"Flag Type: "_$PIECE($GET(PSBROOT(PSBIDX,"FLAGTYPE")),U,2)
+9 IF $Y>(IOSL-12)
WRITE $$PTFTR^PSBOHDR(),$$PTHDR()
+10 WRITE !,"Flag Category: "_$PIECE($GET(PSBROOT(PSBIDX,"CATEGORY")),U,2)
+11 IF $Y>(IOSL-12)
WRITE $$PTFTR^PSBOHDR(),$$PTHDR()
+12 WRITE !,"Assignment Status: "_"Active"
+13 IF $Y>(IOSL-12)
WRITE $$PTFTR^PSBOHDR(),$$PTHDR()
+14 WRITE !,"Initial Assigned Date: "_$PIECE($GET(PSBROOT(PSBIDX,"ASSIGNDT")),U,2)
+15 IF $Y>(IOSL-12)
WRITE $$PTFTR^PSBOHDR(),$$PTHDR()
+16 WRITE !,"Approved by: "_$PIECE($GET(PSBROOT(PSBIDX,"APPRVBY")),U,2)
+17 IF $Y>(IOSL-12)
WRITE $$PTFTR^PSBOHDR(),$$PTHDR()
+18 WRITE !,"Next Review Date: "_$PIECE($GET(PSBROOT(PSBIDX,"REVIEWDT")),U,2)
+19 IF $Y>(IOSL-12)
WRITE $$PTFTR^PSBOHDR(),$$PTHDR()
+20 WRITE !,"Owner Site: "_$PIECE($GET(PSBROOT(PSBIDX,"OWNER")),U,2)
+21 IF $Y>(IOSL-12)
WRITE $$PTFTR^PSBOHDR(),$$PTHDR()
+22 WRITE !,"Originating Site: "_$PIECE($GET(PSBROOT(PSBIDX,"ORIGSITE")),U,2)
+23 IF $Y>(IOSL-12)
WRITE $$PTFTR^PSBOHDR(),$$PTHDR()
+24 IF '$DATA(PSBROOT(PSBIDX,"NARR"))
Begin DoDot:2
+25 IF $Y>(IOSL-12)
WRITE $$PTFTR^PSBOHDR(),$$PTHDR()
End DoDot:2
QUIT
+26 WRITE !!,"Assignment Narratives: "
+27 IF $Y>(IOSL-12)
WRITE $$PTFTR^PSBOHDR(),$$PTHDR()
+28 FOR
SET PSBIX=$ORDER(PSBROOT(PSBIDX,"NARR",PSBIX))
if 'PSBIX
QUIT
Begin DoDot:2
+29 WRITE !,$$WRAP^PSBO(5,60,$GET(PSBROOT(PSBIDX,"NARR",PSBIX,0)))
+30 IF $Y>(IOSL-12)
WRITE $$PTFTR^PSBOHDR(),$$PTHDR()
End DoDot:2
+31 WRITE !!,"*End of Flag Narrative*"
+32 IF $Y>(IOSL-12)
WRITE $$PTFTR^PSBOHDR(),$$PTHDR()
End DoDot:1
+33 KILL PSBROOT
+34 QUIT
+35 ;
PATFLG(PSBDFN) ; Create PATient FLaG data.
+1 NEW PSBIDX,PSBIX,PSBCNT
+2 SET PSBIDX=$$GETACT^DGPFAPI(PSBDFN,.PSBPTFLG)
+3 if '$DATA(PSBPTFLG)
QUIT
+4 MERGE PSBROOT=@PSBPTFLG
+5 QUIT
+6 ;
PTHDR() ;
+1 DO PT^PSBOHDR(DFN,.PSBHDR)
+2 QUIT ""
+3 ;
