- 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
