DGPFLMD1 ;ALB/RPM - PRF DISPLAY ACTIVE FLAG ASSIGNMENTS LM ; 5/18/04 9:33am
;;5.3;Registration;**425,554**;Aug 13, 1993
;
EN(DGARRY,DGPFAPI,DGCNT) ;
;
N DGFLG
N DGI
N DGLINE
N DGNARR
N DGNUM
N DGTEXT
;
S (DGNUM,DGFLG,DGLINE)=0
F S DGFLG=$O(DGPFAPI(DGFLG)) Q:'DGFLG D
. S DGNUM=DGNUM+1
. ;
. ;blank line(s)
. F DGI=1:1:$S(DGNUM>1:2,1:1) D
. . S DGLINE=DGLINE+1
. . D SET^DGPFLMU1(DGARRY,DGLINE," ",1,,,.DGCNT)
. ;
. ;Flag Name
. S DGLINE=DGLINE+1
. S DGTEXT=DGNUM_"."
. D SET^DGPFLMU1(DGARRY,DGLINE,DGTEXT,1,IORVON,IORVOFF,.DGCNT)
. S DGTEXT="Flag Name: "
. D SET^DGPFLMU1(DGARRY,DGLINE,DGTEXT,5,,,.DGCNT)
. S DGTEXT="<"_$P(DGPFAPI(DGFLG,"FLAG"),U,2)_">"
. D SET^DGPFLMU1(DGARRY,DGLINE,DGTEXT,16,IORVON,IORVOFF,.DGCNT)
. ;
. ;Category
. S DGLINE=DGLINE+1
. S DGTEXT="Category: "_$P(DGPFAPI(DGFLG,"CATEGORY"),U,2)
. D SET^DGPFLMU1(DGARRY,DGLINE,DGTEXT,6,,,.DGCNT)
. ;
. ;Flag Type
. S DGLINE=DGLINE+1
. S DGTEXT="Type: "_$P(DGPFAPI(DGFLG,"FLAGTYPE"),U,2)
. D SET^DGPFLMU1(DGARRY,DGLINE,DGTEXT,10,,,.DGCNT)
. ;
. ;Assignment Narrative
. S DGLINE=DGLINE+1
. D SET^DGPFLMU1(DGARRY,DGLINE," ",1,,,.DGCNT)
. S DGLINE=DGLINE+1
. S DGTEXT="Assignment Narrative:"
. D SET^DGPFLMU1(DGARRY,DGLINE,DGTEXT,1,IORVON,IORVOFF,.DGCNT)
. S DGNARR=0
. F S DGNARR=$O(DGPFAPI(DGFLG,"NARR",DGNARR)) Q:'DGNARR D
. . S DGLINE=DGLINE+1
. . S DGTEXT=$G(DGPFAPI(DGFLG,"NARR",DGNARR,0))
. . D SET^DGPFLMU1(DGARRY,DGLINE,DGTEXT,1,,,.DGCNT)
. ;
. ;blank line
. S DGLINE=DGLINE+1
. D SET^DGPFLMU1(DGARRY,DGLINE," ",1,,,.DGCNT)
. ;
. ;assignment details header
. S DGLINE=DGLINE+1
. S DGTEXT="Assignment Details:"
. D SET^DGPFLMU1(DGARRY,DGLINE,DGTEXT,1,IORVON,IORVOFF,.DGCNT)
. ;
. ;Assignment Date
. S DGLINE=DGLINE+1
. S DGTEXT="Initial Assignment: "_$$FMTE^XLFDT($P(DGPFAPI(DGFLG,"ASSIGNDT"),U),"D")
. D SET^DGPFLMU1(DGARRY,DGLINE,DGTEXT,3,,,.DGCNT)
. ;
. ;Approved By
. S DGLINE=DGLINE+1
. S DGTEXT="Approved By: "_$P(DGPFAPI(DGFLG,"APPRVBY"),U,2)
. D SET^DGPFLMU1(DGARRY,DGLINE,DGTEXT,10,,,.DGCNT)
. ;
. ;Review Date
. S DGLINE=DGLINE+1
. S DGTEXT="Next Review Date: "_$S($P(DGPFAPI(DGFLG,"REVIEWDT"),U)>0:$$FMTE^XLFDT($P(DGPFAPI(DGFLG,"REVIEWDT"),U),"D"),1:"N/A")
. D SET^DGPFLMU1(DGARRY,DGLINE,DGTEXT,5,,,.DGCNT)
. ;
. ;Owner Site
. S DGLINE=DGLINE+1
. S DGTEXT="Owner Site: "_$P(DGPFAPI(DGFLG,"OWNER"),U,2)
. D SET^DGPFLMU1(DGARRY,DGLINE,DGTEXT,11,,,.DGCNT)
. ;
. ;Originating Site
. S DGLINE=DGLINE+1
. S DGTEXT="Originating Site: "_$P(DGPFAPI(DGFLG,"ORIGSITE"),U,2)
. D SET^DGPFLMU1(DGARRY,DGLINE,DGTEXT,5,,,.DGCNT)
. ;
. ;Progress Note Linked - only defined if Owner of assignment
. I $D(DGPFAPI(DGFLG,"TIULINK")) D
. . S DGLINE=DGLINE+1
. . S DGTEXT="Progress Note Linked: "_$S(+$P(DGPFAPI(DGFLG,"TIULINK"),U):"YES",1:"NO")
. . D SET^DGPFLMU1(DGARRY,DGLINE,DGTEXT,1,,,.DGCNT)
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGPFLMD1 2949 printed Dec 13, 2024@02:48:17 Page 2
DGPFLMD1 ;ALB/RPM - PRF DISPLAY ACTIVE FLAG ASSIGNMENTS LM ; 5/18/04 9:33am
+1 ;;5.3;Registration;**425,554**;Aug 13, 1993
+2 ;
EN(DGARRY,DGPFAPI,DGCNT) ;
+1 ;
+2 NEW DGFLG
+3 NEW DGI
+4 NEW DGLINE
+5 NEW DGNARR
+6 NEW DGNUM
+7 NEW DGTEXT
+8 ;
+9 SET (DGNUM,DGFLG,DGLINE)=0
+10 FOR
SET DGFLG=$ORDER(DGPFAPI(DGFLG))
if 'DGFLG
QUIT
Begin DoDot:1
+11 SET DGNUM=DGNUM+1
+12 ;
+13 ;blank line(s)
+14 FOR DGI=1:1:$SELECT(DGNUM>1:2,1:1)
Begin DoDot:2
+15 SET DGLINE=DGLINE+1
+16 DO SET^DGPFLMU1(DGARRY,DGLINE," ",1,,,.DGCNT)
End DoDot:2
+17 ;
+18 ;Flag Name
+19 SET DGLINE=DGLINE+1
+20 SET DGTEXT=DGNUM_"."
+21 DO SET^DGPFLMU1(DGARRY,DGLINE,DGTEXT,1,IORVON,IORVOFF,.DGCNT)
+22 SET DGTEXT="Flag Name: "
+23 DO SET^DGPFLMU1(DGARRY,DGLINE,DGTEXT,5,,,.DGCNT)
+24 SET DGTEXT="<"_$PIECE(DGPFAPI(DGFLG,"FLAG"),U,2)_">"
+25 DO SET^DGPFLMU1(DGARRY,DGLINE,DGTEXT,16,IORVON,IORVOFF,.DGCNT)
+26 ;
+27 ;Category
+28 SET DGLINE=DGLINE+1
+29 SET DGTEXT="Category: "_$PIECE(DGPFAPI(DGFLG,"CATEGORY"),U,2)
+30 DO SET^DGPFLMU1(DGARRY,DGLINE,DGTEXT,6,,,.DGCNT)
+31 ;
+32 ;Flag Type
+33 SET DGLINE=DGLINE+1
+34 SET DGTEXT="Type: "_$PIECE(DGPFAPI(DGFLG,"FLAGTYPE"),U,2)
+35 DO SET^DGPFLMU1(DGARRY,DGLINE,DGTEXT,10,,,.DGCNT)
+36 ;
+37 ;Assignment Narrative
+38 SET DGLINE=DGLINE+1
+39 DO SET^DGPFLMU1(DGARRY,DGLINE," ",1,,,.DGCNT)
+40 SET DGLINE=DGLINE+1
+41 SET DGTEXT="Assignment Narrative:"
+42 DO SET^DGPFLMU1(DGARRY,DGLINE,DGTEXT,1,IORVON,IORVOFF,.DGCNT)
+43 SET DGNARR=0
+44 FOR
SET DGNARR=$ORDER(DGPFAPI(DGFLG,"NARR",DGNARR))
if 'DGNARR
QUIT
Begin DoDot:2
+45 SET DGLINE=DGLINE+1
+46 SET DGTEXT=$GET(DGPFAPI(DGFLG,"NARR",DGNARR,0))
+47 DO SET^DGPFLMU1(DGARRY,DGLINE,DGTEXT,1,,,.DGCNT)
End DoDot:2
+48 ;
+49 ;blank line
+50 SET DGLINE=DGLINE+1
+51 DO SET^DGPFLMU1(DGARRY,DGLINE," ",1,,,.DGCNT)
+52 ;
+53 ;assignment details header
+54 SET DGLINE=DGLINE+1
+55 SET DGTEXT="Assignment Details:"
+56 DO SET^DGPFLMU1(DGARRY,DGLINE,DGTEXT,1,IORVON,IORVOFF,.DGCNT)
+57 ;
+58 ;Assignment Date
+59 SET DGLINE=DGLINE+1
+60 SET DGTEXT="Initial Assignment: "_$$FMTE^XLFDT($PIECE(DGPFAPI(DGFLG,"ASSIGNDT"),U),"D")
+61 DO SET^DGPFLMU1(DGARRY,DGLINE,DGTEXT,3,,,.DGCNT)
+62 ;
+63 ;Approved By
+64 SET DGLINE=DGLINE+1
+65 SET DGTEXT="Approved By: "_$PIECE(DGPFAPI(DGFLG,"APPRVBY"),U,2)
+66 DO SET^DGPFLMU1(DGARRY,DGLINE,DGTEXT,10,,,.DGCNT)
+67 ;
+68 ;Review Date
+69 SET DGLINE=DGLINE+1
+70 SET DGTEXT="Next Review Date: "_$SELECT($PIECE(DGPFAPI(DGFLG,"REVIEWDT"),U)>0:$$FMTE^XLFDT($PIECE(DGPFAPI(DGFLG,"REVIEWDT"),U),"D"),1:"N/A")
+71 DO SET^DGPFLMU1(DGARRY,DGLINE,DGTEXT,5,,,.DGCNT)
+72 ;
+73 ;Owner Site
+74 SET DGLINE=DGLINE+1
+75 SET DGTEXT="Owner Site: "_$PIECE(DGPFAPI(DGFLG,"OWNER"),U,2)
+76 DO SET^DGPFLMU1(DGARRY,DGLINE,DGTEXT,11,,,.DGCNT)
+77 ;
+78 ;Originating Site
+79 SET DGLINE=DGLINE+1
+80 SET DGTEXT="Originating Site: "_$PIECE(DGPFAPI(DGFLG,"ORIGSITE"),U,2)
+81 DO SET^DGPFLMU1(DGARRY,DGLINE,DGTEXT,5,,,.DGCNT)
+82 ;
+83 ;Progress Note Linked - only defined if Owner of assignment
+84 IF $DATA(DGPFAPI(DGFLG,"TIULINK"))
Begin DoDot:2
+85 SET DGLINE=DGLINE+1
+86 SET DGTEXT="Progress Note Linked: "_$SELECT(+$PIECE(DGPFAPI(DGFLG,"TIULINK"),U):"YES",1:"NO")
+87 DO SET^DGPFLMU1(DGARRY,DGLINE,DGTEXT,1,,,.DGCNT)
End DoDot:2
End DoDot:1
+88 ;
+89 QUIT