PXAIPOV ;ISL/JVS,ESW - SET THE DIAGNOSIS/PROBLEM LIST NODES ; 6/25/03 2:05pm
;;1.0;PCE PATIENT CARE ENCOUNTER;**28,73,69,108,112**;Aug 12, 1996
;
Q
POV ;--CREATE DIAGNOSIS
;
SET ;--SET AND NEW VARIABLES
N AFTER0,AFTER12,AFTER800,AFTER801,AFTER811,AFTER802,AFTER812
N BEFOR0,BEFOR12,BEFOR800,BEFOR801,BEFOR811,BEFOR802,BEFOR812
N PXAA,PXAB,SUB,PIECE,PXAAX,IENB,STOP,VAR,AFTER8A
N FPRI,J,LNARR,GMPSAVED,NOPLLIST,PXDIGNS,VAR,PRI
N POVI,PRVDR,PXBCNT,PXBCNTPL,PXBKY,PXBPMT,PXBSAM,PXBSKY,PXKDONE
;
K PXAERR
S PXAERR(8)=PXAK
S PXAERR(7)="DX/PL"
;
S SUB="" F S SUB=$O(@PXADATA@("DX/PL",PXAK,SUB)) Q:SUB="" D
.S PXAA(SUB)=@PXADATA@("DX/PL",PXAK,SUB)
;
;--VALIDATE ENOUGH DATA
D VAL^PXAIPOVV Q:$G(STOP)
;
SETVARA ;--SET VISIT VARIABLES
S $P(AFTER0,"^",1)=$G(PXAA("DIAGNOSIS"))
I $G(PXAA("DELETE")) S $P(AFTER0,"^",1)="@"
S $P(AFTER0,"^",2)=$G(PATIENT),PXAA("PATIENT")=$G(PATIENT)
S $P(AFTER0,"^",3)=$G(PXAVISIT)
S $P(AFTER0,"^",4)=$G(PXAA("NARRATIVE")) D
.I $G(PXAA("NARRATIVE"))']""!($L($G(PXAA("NARRATIVE")))>245) D
..S PXAA("NARRATIVE")=$$EXTTEXT^PXUTL1($G(PXAA("DIAGNOSIS")),1,80,10,3) ;--TEXT OF NARRATIVE
.S $P(AFTER0,"^",4)=+$$PROVNARR^PXAPI($G(PXAA("NARRATIVE")),9000010.07)
S $P(AFTER0,"^",12)=$S($G(PXAA("PRIMARY"))=1:"P",1:"S")
;--ADDED FOR PATCH 28
S $P(AFTER0,"^",15)=$G(PXAA("LEXICON TERM"))
S $P(AFTER0,"^",16)=$G(PXAA("PL IEN"))
;--END OF NEW PATCH 28
S $P(AFTER12,"^",1)=$G(PXAA("EVENT D/T"))
S $P(AFTER12,"^",4)=$G(PXAA("ENC PROVIDER"))
;PX*1*108
I $G(PXAA("ENC PROVIDER"))]"",'$G(PXAA("DELETE")) D
.S ^TMP("PXAIADDPRV",$J,$G(PXAA("ENC PROVIDER")))=""
;
I $G(PXAA("CATEGORY"))]"" S $P(AFTER802,"^",1)=+$$PROVNARR^PXAPI($G(PXAA("CATEGORY")),9000010.07)
S $P(AFTER811,"^",1)=$G(PXAA("COMMENT"))
;
;
;
;
S $P(AFTER800,"^",1)=$G(PXAA("PL SC"))
S $P(AFTER800,"^",2)=$G(PXAA("PL AO"))
S $P(AFTER800,"^",3)=$G(PXAA("PL IR"))
S $P(AFTER800,"^",4)=$G(PXAA("PL EC"))
S $P(AFTER800,U,5)=$G(PXAA("PL MST"))
S $P(AFTER800,U,6)=$G(PXAA("PL HNC"))
;
;
;
D SCC^PXUTLSCC(PATIENT,$P($G(^AUPNVSIT(PXAVISIT,0)),"^",1),$P($G(^AUPNVSIT(PXAVISIT,0)),"^",22),$G(PXAVISIT),AFTER800,.AFTER800)
;
S $P(AFTER812,"^",3)=$G(PXASOURC)
S $P(AFTER812,"^",2)=$G(PXAPKG)
;
D PL^PXAIPL
;
;
SETPXKA ;--SET PXK ARRAY AFTER
S ^TMP("PXK",$J,"POV",PXAK,0,"AFTER")=$G(AFTER0)
S ^TMP("PXK",$J,"POV",PXAK,12,"AFTER")=$G(AFTER12)
S ^TMP("PXK",$J,"POV",PXAK,800,"AFTER")=$G(AFTER800)
S ^TMP("PXK",$J,"POV",PXAK,802,"AFTER")=$G(AFTER802)
S ^TMP("PXK",$J,"POV",PXAK,811,"AFTER")=$G(AFTER811)
S ^TMP("PXK",$J,"POV",PXAK,812,"AFTER")=$G(AFTER812)
;
SETVARB ;--SET VARIABLES BEFORE
;
;--GET IEN FOR 'PXK NODE'
D POV^PXBGPOV(PXAVISIT)
I $D(^TMP("PXBGPOVMATCH",$J,$G(PXAA("DIAGNOSIS")))) D
.S (^TMP("PXK",$J,"POV",PXAK,"IEN"),IENB)=$O(^TMP("PXBGPOVMATCH",$J,$G(PXAA("DIAGNOSIS")),0))
K ^TMP("PXBGPOVMATCH",$J)
;
BEFOR ;
I $G(IENB) D
.F PIECE=0,12,800,802,811 S ^TMP("PXK",$J,"POV",PXAK,PIECE,"BEFORE")=$G(^AUPNVPOV(IENB,PIECE))
.K ^TMP("PXK",$J,"POV",PXAK,812)
E D
.S (BEFOR0,BEFOR12,BEFOR800,BEFOR802,BEFOR811,BEFOR812)=""
.;
SETPXKB .;--SET PXK ARRAY BEFORE
.S ^TMP("PXK",$J,"POV",PXAK,0,"BEFORE")=$G(BEFOR0)
.S ^TMP("PXK",$J,"POV",PXAK,12,"BEFORE")=$G(BEFOR12)
.S ^TMP("PXK",$J,"POV",PXAK,800,"BEFORE")=$G(BEFOR800)
.S ^TMP("PXK",$J,"POV",PXAK,802,"BEFORE")=$G(BEFOR802)
.S ^TMP("PXK",$J,"POV",PXAK,811,"BEFORE")=$G(BEFOR811)
.S ^TMP("PXK",$J,"POV",PXAK,812,"BEFORE")=$G(BEFOR812)
.S ^TMP("PXK",$J,"POV",PXAK,"IEN")=""
;
MISC ;--MISCELLANEOUS NODE
;
Q
PRIM ;--SET A PROVIDER AS PRIMARY
N PXBCNT,PXBKY,PXBSAM,PXBSKY,PRVDR,FPRI ;108
D PRV^PXBGPRV(PXAVISIT,.PXBSKY,.PXBKY,.PXBSAM,.PXBCNT,.PRVDR,.FPRI) ;108
I $D(PRVDR) Q
I '$D(PXBSKY) Q
;
S $P(AFTER0,"^",1)=$P(^AUPNVPRV($O(PXBSKY(1,0)),0),"^",1)
S $P(AFTER0,"^",2)=$P(^AUPNVSIT(PXAVISIT,0),"^",5)
S $P(AFTER0,"^",3)=PXAVISIT
S $P(AFTER0,"^",4)="P"
S ^TMP("PXK",$J,"PRV",22222,0,"AFTER")=AFTER0
S ^TMP("PXK",$J,"PRV",22222,0,"BEFORE")=$G(^AUPNVPRV($O(PXBSKY(1,0)),0))
S ^TMP("PXK",$J,"PRV",22222,"IEN")=$O(PXBSKY(1,0))
D EN1^PXKMAIN
K PXRDR
K ^TMP("PXBGPOVMATCH",$J)
Q
PXAIPOV ;ISL/JVS,ESW - SET THE DIAGNOSIS/PROBLEM LIST NODES ; 6/25/03 2:05pm
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**28,73,69,108,112**;Aug 12, 1996
+2 ;
+3 QUIT
POV ;--CREATE DIAGNOSIS
+1 ;
SET ;--SET AND NEW VARIABLES
+1 NEW AFTER0,AFTER12,AFTER800,AFTER801,AFTER811,AFTER802,AFTER812
+2 NEW BEFOR0,BEFOR12,BEFOR800,BEFOR801,BEFOR811,BEFOR802,BEFOR812
+3 NEW PXAA,PXAB,SUB,PIECE,PXAAX,IENB,STOP,VAR,AFTER8A
+4 NEW FPRI,J,LNARR,GMPSAVED,NOPLLIST,PXDIGNS,VAR,PRI
+5 NEW POVI,PRVDR,PXBCNT,PXBCNTPL,PXBKY,PXBPMT,PXBSAM,PXBSKY,PXKDONE
+6 ;
+7 KILL PXAERR
+8 SET PXAERR(8)=PXAK
+9 SET PXAERR(7)="DX/PL"
+10 ;
+11 SET SUB=""
FOR
SET SUB=$ORDER(@PXADATA@("DX/PL",PXAK,SUB))
IF SUB=""
QUIT
Begin DoDot:1
+12 SET PXAA(SUB)=@PXADATA@("DX/PL",PXAK,SUB)
End DoDot:1
+13 ;
+14 ;--VALIDATE ENOUGH DATA
+15 DO VAL^PXAIPOVV
IF $GET(STOP)
QUIT
+16 ;
SETVARA ;--SET VISIT VARIABLES
+1 SET $PIECE(AFTER0,"^",1)=$GET(PXAA("DIAGNOSIS"))
+2 IF $GET(PXAA("DELETE"))
SET $PIECE(AFTER0,"^",1)="@"
+3 SET $PIECE(AFTER0,"^",2)=$GET(PATIENT)
SET PXAA("PATIENT")=$GET(PATIENT)
+4 SET $PIECE(AFTER0,"^",3)=$GET(PXAVISIT)
+5 SET $PIECE(AFTER0,"^",4)=$GET(PXAA("NARRATIVE"))
Begin DoDot:1
+6 IF $GET(PXAA("NARRATIVE"))']""!($LENGTH($GET(PXAA("NARRATIVE")))>245)
Begin DoDot:2
+7 ;--TEXT OF NARRATIVE
SET PXAA("NARRATIVE")=$$EXTTEXT^PXUTL1($GET(PXAA("DIAGNOSIS")),1,80,10,3)
End DoDot:2
+8 SET $PIECE(AFTER0,"^",4)=+$$PROVNARR^PXAPI($GET(PXAA("NARRATIVE")),9000010.07)
End DoDot:1
+9 SET $PIECE(AFTER0,"^",12)=$SELECT($GET(PXAA("PRIMARY"))=1:"P",1:"S")
+10 ;--ADDED FOR PATCH 28
+11 SET $PIECE(AFTER0,"^",15)=$GET(PXAA("LEXICON TERM"))
+12 SET $PIECE(AFTER0,"^",16)=$GET(PXAA("PL IEN"))
+13 ;--END OF NEW PATCH 28
+14 SET $PIECE(AFTER12,"^",1)=$GET(PXAA("EVENT D/T"))
+15 SET $PIECE(AFTER12,"^",4)=$GET(PXAA("ENC PROVIDER"))
+16 ;PX*1*108
+17 IF $GET(PXAA("ENC PROVIDER"))]""
IF '$GET(PXAA("DELETE"))
Begin DoDot:1
+18 SET ^TMP("PXAIADDPRV",$JOB,$GET(PXAA("ENC PROVIDER")))=""
End DoDot:1
+19 ;
+20 IF $GET(PXAA("CATEGORY"))]""
SET $PIECE(AFTER802,"^",1)=+$$PROVNARR^PXAPI($GET(PXAA("CATEGORY")),9000010.07)
+21 SET $PIECE(AFTER811,"^",1)=$GET(PXAA("COMMENT"))
+22 ;
+23 ;
+24 ;
+25 ;
+26 SET $PIECE(AFTER800,"^",1)=$GET(PXAA("PL SC"))
+27 SET $PIECE(AFTER800,"^",2)=$GET(PXAA("PL AO"))
+28 SET $PIECE(AFTER800,"^",3)=$GET(PXAA("PL IR"))
+29 SET $PIECE(AFTER800,"^",4)=$GET(PXAA("PL EC"))
+30 SET $PIECE(AFTER800,U,5)=$GET(PXAA("PL MST"))
+31 SET $PIECE(AFTER800,U,6)=$GET(PXAA("PL HNC"))
+32 ;
+33 ;
+34 ;
+35 DO SCC^PXUTLSCC(PATIENT,$PIECE($GET(^AUPNVSIT(PXAVISIT,0)),"^",1),$PIECE($GET(^AUPNVSIT(PXAVISIT,0)),"^",22),$GET(PXAVISIT),AFTER800,.AFTER800)
+36 ;
+37 SET $PIECE(AFTER812,"^",3)=$GET(PXASOURC)
+38 SET $PIECE(AFTER812,"^",2)=$GET(PXAPKG)
+39 ;
+40 DO PL^PXAIPL
+41 ;
+42 ;
SETPXKA ;--SET PXK ARRAY AFTER
+1 SET ^TMP("PXK",$JOB,"POV",PXAK,0,"AFTER")=$GET(AFTER0)
+2 SET ^TMP("PXK",$JOB,"POV",PXAK,12,"AFTER")=$GET(AFTER12)
+3 SET ^TMP("PXK",$JOB,"POV",PXAK,800,"AFTER")=$GET(AFTER800)
+4 SET ^TMP("PXK",$JOB,"POV",PXAK,802,"AFTER")=$GET(AFTER802)
+5 SET ^TMP("PXK",$JOB,"POV",PXAK,811,"AFTER")=$GET(AFTER811)
+6 SET ^TMP("PXK",$JOB,"POV",PXAK,812,"AFTER")=$GET(AFTER812)
+7 ;
SETVARB ;--SET VARIABLES BEFORE
+1 ;
+2 ;--GET IEN FOR 'PXK NODE'
+3 DO POV^PXBGPOV(PXAVISIT)
+4 IF $DATA(^TMP("PXBGPOVMATCH",$JOB,$GET(PXAA("DIAGNOSIS"))))
Begin DoDot:1
+5 SET (^TMP("PXK",$JOB,"POV",PXAK,"IEN"),IENB)=$ORDER(^TMP("PXBGPOVMATCH",$JOB,$GET(PXAA("DIAGNOSIS")),0))
End DoDot:1
+6 KILL ^TMP("PXBGPOVMATCH",$JOB)
+7 ;
BEFOR ;
+1 IF $GET(IENB)
Begin DoDot:1
+2 FOR PIECE=0,12,800,802,811
SET ^TMP("PXK",$JOB,"POV",PXAK,PIECE,"BEFORE")=$GET(^AUPNVPOV(IENB,PIECE))
+3 KILL ^TMP("PXK",$JOB,"POV",PXAK,812)
End DoDot:1
+4 IF '$TEST
Begin DoDot:1
+5 SET (BEFOR0,BEFOR12,BEFOR800,BEFOR802,BEFOR811,BEFOR812)=""
+6 ;
SETPXKB ;--SET PXK ARRAY BEFORE
+1 SET ^TMP("PXK",$JOB,"POV",PXAK,0,"BEFORE")=$GET(BEFOR0)
+2 SET ^TMP("PXK",$JOB,"POV",PXAK,12,"BEFORE")=$GET(BEFOR12)
+3 SET ^TMP("PXK",$JOB,"POV",PXAK,800,"BEFORE")=$GET(BEFOR800)
+4 SET ^TMP("PXK",$JOB,"POV",PXAK,802,"BEFORE")=$GET(BEFOR802)
+5 SET ^TMP("PXK",$JOB,"POV",PXAK,811,"BEFORE")=$GET(BEFOR811)
+6 SET ^TMP("PXK",$JOB,"POV",PXAK,812,"BEFORE")=$GET(BEFOR812)
+7 SET ^TMP("PXK",$JOB,"POV",PXAK,"IEN")=""
End DoDot:1
+8 ;
MISC ;--MISCELLANEOUS NODE
+1 ;
+2 QUIT
PRIM ;--SET A PROVIDER AS PRIMARY
+1 ;108
NEW PXBCNT,PXBKY,PXBSAM,PXBSKY,PRVDR,FPRI
+2 ;108
DO PRV^PXBGPRV(PXAVISIT,.PXBSKY,.PXBKY,.PXBSAM,.PXBCNT,.PRVDR,.FPRI)
+3 IF $DATA(PRVDR)
QUIT
+4 IF '$DATA(PXBSKY)
QUIT
+5 ;
+6 SET $PIECE(AFTER0,"^",1)=$PIECE(^AUPNVPRV($ORDER(PXBSKY(1,0)),0),"^",1)
+7 SET $PIECE(AFTER0,"^",2)=$PIECE(^AUPNVSIT(PXAVISIT,0),"^",5)
+8 SET $PIECE(AFTER0,"^",3)=PXAVISIT
+9 SET $PIECE(AFTER0,"^",4)="P"
+10 SET ^TMP("PXK",$JOB,"PRV",22222,0,"AFTER")=AFTER0
+11 SET ^TMP("PXK",$JOB,"PRV",22222,0,"BEFORE")=$GET(^AUPNVPRV($ORDER(PXBSKY(1,0)),0))
+12 SET ^TMP("PXK",$JOB,"PRV",22222,"IEN")=$ORDER(PXBSKY(1,0))
+13 DO EN1^PXKMAIN
+14 KILL PXRDR
+15 KILL ^TMP("PXBGPOVMATCH",$JOB)
+16 QUIT
