- 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 ""
- ;
- 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 ;
