BEHOPLCV ;MSC/IND/DKM - Cover Sheet: Problem List ;21-May-2013 15:04;DU
;;1.1;BEH COMPONENTS;**034001,034002**;Mar 20, 2007
;=================================================================
; Return pt's problem list.
LIST(DATA,DFN,STATUS) ;EP
N CNT,LP,PLST
S DATA=$$TMPGBL^CIAVMRPC,CNT=0
Q:'DFN
I $L($T(LIST^GMPLUTL2)) D
.S @DATA@(1)="^No problems found.",LP=0
.D LIST^GMPLUTL2(.PLST,DFN,STATUS)
.F S LP=$O(PLST(LP)) Q:'LP D ADD(PLST(LP))
E D ADD("^Problem list not available.")
Q
; Return problem detail
DETAIL(DATA,DFN,IEN) ;EP
N PLST,GMPDT,CNT,LP,X
S DATA=$$TMPGBL^CIAVMRPC,CNT=0
I $L($T(DETAIL^BEHOPLDD)) D
.D DETAIL^BEHOPLDD(.DATA,IEN,DFN)
E D
.I $L($T(DETAIL^GMPLUTL2)) D
..D DETAIL^GMPLUTL2(IEN,.PLST)
..Q:$D(PLST)'>1
..D ADD(PLST("NARRATIVE")_" ("_PLST("DIAGNOSIS")_")"),ADD()
..D ADD(PLST("ONSET"),"Onset:")
..D ADD(PLST("STATUS")_"/"_PLST("PRIORITY"),"Status:")
..D ADD(PLST("SC"),"SC Cond:")
..D ADD($S($G(PLST("EXPOSURE"))>0:PLST("EXPOSURE",1),1:"None"),"Exposure:")
..I $G(PLST("EXPOSURE"))>1 D
...F LP=2:1:PLST("EXPOSURE") D ADD(PLST("EXPOSURE",LP),"")
..D ADD()
..D ADD(PLST("PROVIDER"),"Provider:")
..D ADD(PLST("CLINIC"),"Clinic:")
..D ADD()
..D ADD($P(PLST("RECORDED"),U)_", by "_$P(PLST("RECORDED"),U,2),"Recorded:")
..D ADD($P(PLST("ENTERED"),U)_", by "_$P(PLST("ENTERED"),U,2),"Entered:")
..D ADD(PLST("MODIFIED"),"Updated:")
..D ADD()
..I $G(PLST("COMMENT"))>0 D
...D ADD("----------- Comments -----------")
...F LP=1:1:PLST("COMMENT") D
....S X=PLST("COMMENT",LP)
....D ADD($P(X,U)_" by "_$P(X,U,2)_": "_$P(X,U,3))
..D:$D(^GMPL(125.8,"B",IEN)) HIST
.D:'CNT ADD("Problem detail not available.")
Q
; Get audit history
HIST N IDT,AIFN,LBL,TXT,GMPDT,LCNT,X
D ADD(),ADD("-------- Audit History ---------")
S (LCNT,IDT)=0
F S IDT=$O(^GMPL(125.8,"AD",IEN,IDT)),AIFN=0 Q:'IDT D
.F S AIFN=$O(^GMPL(125.8,"AD",IEN,IDT,AIFN)) Q:'AIFN D DT^GMPLHIST
S LP="",TXT=""
F S LP=$O(GMPDT(LP)) Q:LP="" D
.S X=GMPDT(LP,0)
.I $L(X,": ")>1 D
..D:$L(TXT) ADD(TXT,LBL)
..S LBL=$$TRIM^CIAU($P(X,": "))_":",TXT=$$TRIM^CIAU($P(LBL,": ",2,999)) ; start new text string
.E S TXT=TXT_" "_$$TRIM^CIAU(X) ; line does not begin with date, so add to existing text line
D:$L(TXT) ADD(TXT,LBL)
Q
; Add to output array
ADD(TXT,LBL) ;
S CNT=CNT+1,@DATA@(CNT)=$S($D(LBL):$$LJ^XLFSTR(LBL,20),1:"")_$G(TXT),LBL=""
Q
BEHOPLCV ;MSC/IND/DKM - Cover Sheet: Problem List ;21-May-2013 15:04;DU
+1 ;;1.1;BEH COMPONENTS;**034001,034002**;Mar 20, 2007
+2 ;=================================================================
+3 ; Return pt's problem list.
LIST(DATA,DFN,STATUS) ;EP
+1 NEW CNT,LP,PLST
+2 SET DATA=$$TMPGBL^CIAVMRPC
SET CNT=0
+3 IF 'DFN
QUIT
+4 IF $LENGTH($TEXT(LIST^GMPLUTL2))
Begin DoDot:1
+5 SET @DATA@(1)="^No problems found."
SET LP=0
+6 DO LIST^GMPLUTL2(.PLST,DFN,STATUS)
+7 FOR
SET LP=$ORDER(PLST(LP))
IF 'LP
QUIT
DO ADD(PLST(LP))
End DoDot:1
+8 IF '$TEST
DO ADD("^Problem list not available.")
+9 QUIT
+10 ; Return problem detail
DETAIL(DATA,DFN,IEN) ;EP
+1 NEW PLST,GMPDT,CNT,LP,X
+2 SET DATA=$$TMPGBL^CIAVMRPC
SET CNT=0
+3 IF $LENGTH($TEXT(DETAIL^BEHOPLDD))
Begin DoDot:1
+4 DO DETAIL^BEHOPLDD(.DATA,IEN,DFN)
End DoDot:1
+5 IF '$TEST
Begin DoDot:1
+6 IF $LENGTH($TEXT(DETAIL^GMPLUTL2))
Begin DoDot:2
+7 DO DETAIL^GMPLUTL2(IEN,.PLST)
+8 IF $DATA(PLST)'>1
QUIT
+9 DO ADD(PLST("NARRATIVE")_" ("_PLST("DIAGNOSIS")_")")
DO ADD()
+10 DO ADD(PLST("ONSET"),"Onset:")
+11 DO ADD(PLST("STATUS")_"/"_PLST("PRIORITY"),"Status:")
+12 DO ADD(PLST("SC"),"SC Cond:")
+13 DO ADD($SELECT($GET(PLST("EXPOSURE"))>0:PLST("EXPOSURE",1),1:"None"),"Exposure:")
+14 IF $GET(PLST("EXPOSURE"))>1
Begin DoDot:3
+15 FOR LP=2:1:PLST("EXPOSURE")
DO ADD(PLST("EXPOSURE",LP),"")
End DoDot:3
+16 DO ADD()
+17 DO ADD(PLST("PROVIDER"),"Provider:")
+18 DO ADD(PLST("CLINIC"),"Clinic:")
+19 DO ADD()
+20 DO ADD($PIECE(PLST("RECORDED"),U)_", by "_$PIECE(PLST("RECORDED"),U,2),"Recorded:")
+21 DO ADD($PIECE(PLST("ENTERED"),U)_", by "_$PIECE(PLST("ENTERED"),U,2),"Entered:")
+22 DO ADD(PLST("MODIFIED"),"Updated:")
+23 DO ADD()
+24 IF $GET(PLST("COMMENT"))>0
Begin DoDot:3
+25 DO ADD("----------- Comments -----------")
+26 FOR LP=1:1:PLST("COMMENT")
Begin DoDot:4
+27 SET X=PLST("COMMENT",LP)
+28 DO ADD($PIECE(X,U)_" by "_$PIECE(X,U,2)_": "_$PIECE(X,U,3))
End DoDot:4
End DoDot:3
+29 IF $DATA(^GMPL(125.8,"B",IEN))
DO HIST
End DoDot:2
+30 IF 'CNT
DO ADD("Problem detail not available.")
End DoDot:1
+31 QUIT
+32 ; Get audit history
HIST NEW IDT,AIFN,LBL,TXT,GMPDT,LCNT,X
+1 DO ADD()
DO ADD("-------- Audit History ---------")
+2 SET (LCNT,IDT)=0
+3 FOR
SET IDT=$ORDER(^GMPL(125.8,"AD",IEN,IDT))
SET AIFN=0
IF 'IDT
QUIT
Begin DoDot:1
+4 FOR
SET AIFN=$ORDER(^GMPL(125.8,"AD",IEN,IDT,AIFN))
IF 'AIFN
QUIT
DO DT^GMPLHIST
End DoDot:1
+5 SET LP=""
SET TXT=""
+6 FOR
SET LP=$ORDER(GMPDT(LP))
IF LP=""
QUIT
Begin DoDot:1
+7 SET X=GMPDT(LP,0)
+8 IF $LENGTH(X,": ")>1
Begin DoDot:2
+9 IF $LENGTH(TXT)
DO ADD(TXT,LBL)
+10 ; start new text string
SET LBL=$$TRIM^CIAU($PIECE(X,": "))_":"
SET TXT=$$TRIM^CIAU($PIECE(LBL,": ",2,999))
End DoDot:2
+11 ; line does not begin with date, so add to existing text line
IF '$TEST
SET TXT=TXT_" "_$$TRIM^CIAU(X)
End DoDot:1
+12 IF $LENGTH(TXT)
DO ADD(TXT,LBL)
+13 QUIT
+14 ; Add to output array
ADD(TXT,LBL) ;
+1 SET CNT=CNT+1
SET @DATA@(CNT)=$SELECT($DATA(LBL):$$LJ^XLFSTR(LBL,20),1:"")_$GET(TXT)
SET LBL=""
+2 QUIT
