PXAIPL ;ISL/JVS - PROBLEM LIST ;Dec 31, 2025@13:20:28
;;1.0;PCE PATIENT CARE ENCOUNTER;**69,124,168,199,211,244**;Aug 12, 1996;Build 37
;
; Reference to UPDATE^GMPLUTL in ICR #928
; Reference to $$SHOWSA^GMPLSPECAUTH in ICR #7586
;
Q
PL ;--ENTRY POINT TO EDIT PROBLEMS
;
;
Q:'$L($T(^GMPLUTL))
;
N PXARRAY,RESULT
DECIDE ;--DECIDE IF A PROBLEM
I $G(PXAA("PL ADD"))=1 G SET
I $G(PXAA("PL IEN"))>0 G SET
I $G(PXAA("PL ACTIVE"))]"" G SET
I $G(PXAA("PL ONSET DATE"))>0 G SET
I $G(PXAA("PL RESOLVED DATE"))>0 G SET
;PX*1.0*124
;I $G(PXAA("PL SC"))]"" G SET
;I $G(PXAA("PL AO"))]"" G SET
;I $G(PXAA("PL IR"))]"" G SET
;I $G(PXAA("PL EC"))]"" G SET
;I $G(PXAA("PL MST"))]"" G SET
;I $G(PXAA("PL HNC"))]"" G SET
;I $G(PXAA("PL CV"))]"" G SET
;I $G(PXAA("PL SHAD"))]"" G SET
Q
;
;
SET ;--REQUIRED
N CNT,IDX,NODE,SIDX
S PXARRAY("PATIENT")=$G(PATIENT)
S PXARRAY("NARRATIVE")=$G(PXAA("NARRATIVE"))
S PXARRAY("PROVIDER")=$G(PXAA("ENC PROVIDER"))
;--OPTIONAL
S PXARRAY("DIAGNOSIS")=$G(PXAA("DIAGNOSIS"))
S PXARRAY("DX_DATE_OF_INTEREST")=$$CSDATE^PXDXUTL(PXAVISIT)
S PXARRAY("LEXICON")=$G(PXAA("LEXICON TERM"))
S PXARRAY("STATUS")=$G(PXAA("PL ACTIVE"))
S PXARRAY("ONSET")=$G(PXAA("PL ONSET DATE"))
I '$G(PXAA("PL IEN")) S PXARRAY("RECORDED")=$G(PXAA("EVENT D/T"))
S PXARRAY("RESOLVED")=$G(PXAA("PL RESOLVED DATE"))
S PXARRAY("COMMENT")=$G(PXAA("COMMENT"))
I $G(PXARRAY("COMMENT"))="@" S PXARRAY("COMMENT")=""
;--LOCATION
S PXARRAY("LOCATION")=$P($G(^AUPNVSIT(PXAVISIT,0)),"^",22)
;--SERVICE CONNECTEDNESS
I $$SHOWSA^GMPLSPECAUTH D
.S IDX=0,CNT=0 F S IDX=$O(AFTER900(IDX)) Q:IDX'>0 D
..S NODE=AFTER900(IDX,0),SIDX=+NODE I SIDX=0 Q
..I $P(NODE,U,2)="" Q
..S CNT=CNT+1
..S PXARRAY(2,CNT)=SIDX_U_$P(NODE,U,2)
;
;---MISC
S PXARRAY("PROBLEM")=$G(PXAA("PL IEN"))
;
RUN ;
D UPDATE^GMPLUTL(.PXARRAY,.RESULT)
I RESULT(0)="" S $P(AFTER0,"^",16)=RESULT
;--**SET ERROR INTO DIALOG
I RESULT(0)]"" D
.S PXAERR("PL1")=$G(RESULT(0))
.S PXAERRF("PL")=1
.S PXADI("DIALOG")=8390001.004
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXAIPL 2084 printed May 25, 2026@12:29:37 Page 2
PXAIPL ;ISL/JVS - PROBLEM LIST ;Dec 31, 2025@13:20:28
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**69,124,168,199,211,244**;Aug 12, 1996;Build 37
+2 ;
+3 ; Reference to UPDATE^GMPLUTL in ICR #928
+4 ; Reference to $$SHOWSA^GMPLSPECAUTH in ICR #7586
+5 ;
+6 QUIT
PL ;--ENTRY POINT TO EDIT PROBLEMS
+1 ;
+2 ;
+3 if '$LENGTH($TEXT(^GMPLUTL))
QUIT
+4 ;
+5 NEW PXARRAY,RESULT
DECIDE ;--DECIDE IF A PROBLEM
+1 IF $GET(PXAA("PL ADD"))=1
GOTO SET
+2 IF $GET(PXAA("PL IEN"))>0
GOTO SET
+3 IF $GET(PXAA("PL ACTIVE"))]""
GOTO SET
+4 IF $GET(PXAA("PL ONSET DATE"))>0
GOTO SET
+5 IF $GET(PXAA("PL RESOLVED DATE"))>0
GOTO SET
+6 ;PX*1.0*124
+7 ;I $G(PXAA("PL SC"))]"" G SET
+8 ;I $G(PXAA("PL AO"))]"" G SET
+9 ;I $G(PXAA("PL IR"))]"" G SET
+10 ;I $G(PXAA("PL EC"))]"" G SET
+11 ;I $G(PXAA("PL MST"))]"" G SET
+12 ;I $G(PXAA("PL HNC"))]"" G SET
+13 ;I $G(PXAA("PL CV"))]"" G SET
+14 ;I $G(PXAA("PL SHAD"))]"" G SET
+15 QUIT
+16 ;
+17 ;
SET ;--REQUIRED
+1 NEW CNT,IDX,NODE,SIDX
+2 SET PXARRAY("PATIENT")=$GET(PATIENT)
+3 SET PXARRAY("NARRATIVE")=$GET(PXAA("NARRATIVE"))
+4 SET PXARRAY("PROVIDER")=$GET(PXAA("ENC PROVIDER"))
+5 ;--OPTIONAL
+6 SET PXARRAY("DIAGNOSIS")=$GET(PXAA("DIAGNOSIS"))
+7 SET PXARRAY("DX_DATE_OF_INTEREST")=$$CSDATE^PXDXUTL(PXAVISIT)
+8 SET PXARRAY("LEXICON")=$GET(PXAA("LEXICON TERM"))
+9 SET PXARRAY("STATUS")=$GET(PXAA("PL ACTIVE"))
+10 SET PXARRAY("ONSET")=$GET(PXAA("PL ONSET DATE"))
+11 IF '$GET(PXAA("PL IEN"))
SET PXARRAY("RECORDED")=$GET(PXAA("EVENT D/T"))
+12 SET PXARRAY("RESOLVED")=$GET(PXAA("PL RESOLVED DATE"))
+13 SET PXARRAY("COMMENT")=$GET(PXAA("COMMENT"))
+14 IF $GET(PXARRAY("COMMENT"))="@"
SET PXARRAY("COMMENT")=""
+15 ;--LOCATION
+16 SET PXARRAY("LOCATION")=$PIECE($GET(^AUPNVSIT(PXAVISIT,0)),"^",22)
+17 ;--SERVICE CONNECTEDNESS
+18 IF $$SHOWSA^GMPLSPECAUTH
Begin DoDot:1
+19 SET IDX=0
SET CNT=0
FOR
SET IDX=$ORDER(AFTER900(IDX))
if IDX'>0
QUIT
Begin DoDot:2
+20 SET NODE=AFTER900(IDX,0)
SET SIDX=+NODE
IF SIDX=0
QUIT
+21 IF $PIECE(NODE,U,2)=""
QUIT
+22 SET CNT=CNT+1
+23 SET PXARRAY(2,CNT)=SIDX_U_$PIECE(NODE,U,2)
End DoDot:2
End DoDot:1
+24 ;
+25 ;---MISC
+26 SET PXARRAY("PROBLEM")=$GET(PXAA("PL IEN"))
+27 ;
RUN ;
+1 DO UPDATE^GMPLUTL(.PXARRAY,.RESULT)
+2 IF RESULT(0)=""
SET $PIECE(AFTER0,"^",16)=RESULT
+3 ;--**SET ERROR INTO DIALOG
+4 IF RESULT(0)]""
Begin DoDot:1
+5 SET PXAERR("PL1")=$GET(RESULT(0))
+6 SET PXAERRF("PL")=1
+7 SET PXADI("DIALOG")=8390001.004
End DoDot:1
+8 QUIT
