PXAIPRV ;ISL/JVS,ESW - SET THE PROVIDER NODES ; 11/25/02 3:36pm
;;1.0;PCE PATIENT CARE ENCOUNTER;**5,108**;Aug 12, 1996
;
Q
PRV ;--CREAT PROVIDERS
;
SET ;--SET AND NEW VARIABLES
N AFTER0,AFTER12,AFTER801,AFTER811,AFTER812
N BEFOR0,BEFOR12,BEFOR801,BEFOR811,BEFOR812
N PXAA,PXAB,SUB,PIECE,PXAAX,IENB,STOP
;
K PXAERR
S PXAERR(8)=PXAK
S PXAERR(7)="PROVIDER"
;
S SUB="" F S SUB=$O(@PXADATA@("PROVIDER",PXAK,SUB)) Q:SUB="" D
.S PXAA(SUB)=@PXADATA@("PROVIDER",PXAK,SUB)
;
;--VALIDATE ENOUGH DATA
D VAL^PXAIPRVV Q:$G(STOP)
;
SETVARA ;--SET VISIT VARIABLES
S $P(AFTER0,"^",1)=$G(PXAA("NAME"))
I $G(PXAA("DELETE")) S $P(AFTER0,"^",1)="@"
S $P(AFTER0,"^",2)=$G(PATIENT)
S $P(AFTER0,"^",3)=$G(PXAVISIT)
S $P(AFTER0,"^",4)=$S($G(PXAA("PRIMARY"))=1:"P",1:"S")
S $P(AFTER0,"^",5)=$S($G(PXAA("ATTENDING"))=1:"A",$G(PXAA("ATTENDING"))=0:"@",1:"")
S $P(AFTER811,"^",1)=$G(PXAA("COMMENT"))
;
;
S $P(AFTER812,"^",2)=$G(PXAPKG)
S $P(AFTER812,"^",3)=$G(PXASOURC)
;
SETPXKA ;--SET PXK ARRAY AFTER
S ^TMP("PXK",$J,"PRV",PXAK,0,"AFTER")=AFTER0
S ^TMP("PXK",$J,"PRV",PXAK,811,"AFTER")=AFTER811
S ^TMP("PXK",$J,"PRV",PXAK,812,"AFTER")=AFTER812
;
SETVARB ;--SET VARIABLES BEFORE
;
;--CHECK FOR PRIMARY DESIGNATION
N ITEM,PXBSKY,PXBKY,PXBSAM,PXBCNT,PRVDR,FPRI
D PRV^PXBGPRV(PXAVISIT,.PXBSKY,.PXBKY,.PXBSAM,.PXBCNT,.PRVDR,.FPRI)
;CHECK NAME
S PXAAX("NAME")=$P($G(^VA(200,$G(PXAA("NAME")),0)),"^",1)
I '$G(PXAPREDT) D
1 .I $D(PRVDR),$P($G(PRVDR("PRIMARY")),U)'=PXAAX("NAME") S PRI=1
2 .I $G(PRI) S $P(^TMP("PXK",$J,"PRV",PXAK,0,"AFTER"),"^",4)="S"
3 .I $G(PRI),$G(PXAA("NAME"))'["@" D VAL04^PXAIPRVV,ERR^PXAI
4 .I $P(AFTER0,"^",4)="P" S PRI=1
;
;--GET IEN FOR 'PXK NODE'
I $G(PXAA("DELETE"))=1 S PXAAX("NAME")=$P($G(^VA(200,PXAA("NAME"),0)),"^",1)
S ITEM="" I PXBCNT>0,$G(PXAAX("NAME"))]"" S ITEM=$O(PXBKY(PXAAX("NAME"),0))
I ITEM]"" S (^TMP("PXK",$J,"PRV",PXAK,"IEN"),IENB)=$O(PXBSKY(ITEM,0))
;
I $G(IENB) D
.F PIECE=0,811,812 S ^TMP("PXK",$J,"PRV",PXAK,PIECE,"BEFORE")=$G(^AUPNVPRV(IENB,PIECE))
E D
.S (BEFOR0,BEFOR811,BEFOR812)=""
.;
SETPXKB .;--SET PXK ARRAY BEFORE
.S ^TMP("PXK",$J,"PRV",PXAK,0,"BEFORE")=BEFOR0
.S ^TMP("PXK",$J,"PRV",PXAK,811,"BEFORE")=BEFOR811
.S ^TMP("PXK",$J,"PRV",PXAK,812,"BEFORE")=BEFOR812
.S ^TMP("PXK",$J,"PRV",PXAK,"IEN")=""
;
MISC ;--MISCELLANEOUS NODE
;
Q
OTHER ;---ADD OTHER PROVIDERS TO V PROVIDER FOR OTHER ENTRIES
;
; generate data, PXBSKY(), about currently filed providers
;
N PXBSKY
I $G(PXAVISIT) D PRV^PXBGPRV(PXAVISIT,.PXBSKY)
;
N IEN,AFTER0,CNT,PXAK,STOP,FF
S IEN="",CNT=1000
;
;---^TMP("PXAIADDPRV",$J,'IEN')=""
;
F S IEN=$O(^TMP("PXAIADDPRV",$J,IEN)),CNT=CNT+1 Q:IEN="" D
.;
.;verify if an entry for a provider already exists
.;
.S STOP=0
.I $D(^TMP("PXK",$J,"PRV")) S PXAK="" D Q:STOP
..F S PXAK=$O(^TMP("PXK",$J,"PRV",PXAK)) Q:PXAK="" D Q:STOP
...I +$G(^TMP("PXK",$J,"PRV",PXAK,0,"AFTER"))=IEN S STOP=1
.S FF="PXBSKY" F S FF=$Q(@FF) Q:FF="" I @FF=IEN S STOP=1 Q
.Q:STOP
.;
.S $P(AFTER0,"^",1)=IEN
.S $P(AFTER0,"^",2)=$P(^AUPNVSIT(PXAVISIT,0),"^",5)
.S $P(AFTER0,"^",3)=PXAVISIT
.S $P(AFTER0,"^",4)="S"
.S $P(AFTER812,"^",2)=$G(PXAPKG)
.S $P(AFTER812,"^",3)=$G(PXASOURC)
.S ^TMP("PXK",$J,"PRV",CNT,0,"AFTER")=$G(AFTER0)
.S ^TMP("PXK",$J,"PRV",CNT,811,"AFTER")=""
.S ^TMP("PXK",$J,"PRV",CNT,812,"AFTER")=$G(AFTER812)
.S ^TMP("PXK",$J,"PRV",CNT,0,"BEFORE")=""
.S ^TMP("PXK",$J,"PRV",CNT,811,"BEFORE")=""
.S ^TMP("PXK",$J,"PRV",CNT,811,"BEFORE")=""
.S ^TMP("PXK",$J,"PRV",CNT,"IEN")=""
Q
PRIM ;--SET A PROVIDER AS PRIMARY
N PXBCNT,PXBKY,PXBSAM,PXBSKY,AFTER0,FPRI,PRVDR,PXASOR
D PRV^PXBGPRV(PXAVISIT,.PXBSKY,.PXBKY,.PXBSAM,.PXBCNT,.PRVDR,.FPRI)
I $D(PRVDR) Q
I '$D(PXBSKY) Q
;----ADDED
S PXASOR=$G(^TMP("PXK",$J,"SOR"))
K ^TMP("PXK",$J)
S ^TMP("PXK",$J,"SOR")=$G(PXASOR)
S ^TMP("PXK",$J,"VST",1,"IEN")=PXAVISIT
;-------
;
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
Q
PXAIPRV ;ISL/JVS,ESW - SET THE PROVIDER NODES ; 11/25/02 3:36pm
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**5,108**;Aug 12, 1996
+2 ;
+3 QUIT
PRV ;--CREAT PROVIDERS
+1 ;
SET ;--SET AND NEW VARIABLES
+1 NEW AFTER0,AFTER12,AFTER801,AFTER811,AFTER812
+2 NEW BEFOR0,BEFOR12,BEFOR801,BEFOR811,BEFOR812
+3 NEW PXAA,PXAB,SUB,PIECE,PXAAX,IENB,STOP
+4 ;
+5 KILL PXAERR
+6 SET PXAERR(8)=PXAK
+7 SET PXAERR(7)="PROVIDER"
+8 ;
+9 SET SUB=""
FOR
SET SUB=$ORDER(@PXADATA@("PROVIDER",PXAK,SUB))
IF SUB=""
QUIT
Begin DoDot:1
+10 SET PXAA(SUB)=@PXADATA@("PROVIDER",PXAK,SUB)
End DoDot:1
+11 ;
+12 ;--VALIDATE ENOUGH DATA
+13 DO VAL^PXAIPRVV
IF $GET(STOP)
QUIT
+14 ;
SETVARA ;--SET VISIT VARIABLES
+1 SET $PIECE(AFTER0,"^",1)=$GET(PXAA("NAME"))
+2 IF $GET(PXAA("DELETE"))
SET $PIECE(AFTER0,"^",1)="@"
+3 SET $PIECE(AFTER0,"^",2)=$GET(PATIENT)
+4 SET $PIECE(AFTER0,"^",3)=$GET(PXAVISIT)
+5 SET $PIECE(AFTER0,"^",4)=$SELECT($GET(PXAA("PRIMARY"))=1:"P",1:"S")
+6 SET $PIECE(AFTER0,"^",5)=$SELECT($GET(PXAA("ATTENDING"))=1:"A",$GET(PXAA("ATTENDING"))=0:"@",1:"")
+7 SET $PIECE(AFTER811,"^",1)=$GET(PXAA("COMMENT"))
+8 ;
+9 ;
+10 SET $PIECE(AFTER812,"^",2)=$GET(PXAPKG)
+11 SET $PIECE(AFTER812,"^",3)=$GET(PXASOURC)
+12 ;
SETPXKA ;--SET PXK ARRAY AFTER
+1 SET ^TMP("PXK",$JOB,"PRV",PXAK,0,"AFTER")=AFTER0
+2 SET ^TMP("PXK",$JOB,"PRV",PXAK,811,"AFTER")=AFTER811
+3 SET ^TMP("PXK",$JOB,"PRV",PXAK,812,"AFTER")=AFTER812
+4 ;
SETVARB ;--SET VARIABLES BEFORE
+1 ;
+2 ;--CHECK FOR PRIMARY DESIGNATION
+3 NEW ITEM,PXBSKY,PXBKY,PXBSAM,PXBCNT,PRVDR,FPRI
+4 DO PRV^PXBGPRV(PXAVISIT,.PXBSKY,.PXBKY,.PXBSAM,.PXBCNT,.PRVDR,.FPRI)
+5 ;CHECK NAME
+6 SET PXAAX("NAME")=$PIECE($GET(^VA(200,$GET(PXAA("NAME")),0)),"^",1)
+7 IF '$GET(PXAPREDT)
Begin DoDot:1
1 IF $DATA(PRVDR)
IF $PIECE($GET(PRVDR("PRIMARY")),U)'=PXAAX("NAME")
SET PRI=1
2 IF $GET(PRI)
SET $PIECE(^TMP("PXK",$JOB,"PRV",PXAK,0,"AFTER"),"^",4)="S"
3 IF $GET(PRI)
IF $GET(PXAA("NAME"))'["@"
DO VAL04^PXAIPRVV
DO ERR^PXAI
4 IF $PIECE(AFTER0,"^",4)="P"
SET PRI=1
End DoDot:1
+1 ;
+2 ;--GET IEN FOR 'PXK NODE'
+3 IF $GET(PXAA("DELETE"))=1
SET PXAAX("NAME")=$PIECE($GET(^VA(200,PXAA("NAME"),0)),"^",1)
+4 SET ITEM=""
IF PXBCNT>0
IF $GET(PXAAX("NAME"))]""
SET ITEM=$ORDER(PXBKY(PXAAX("NAME"),0))
+5 IF ITEM]""
SET (^TMP("PXK",$JOB,"PRV",PXAK,"IEN"),IENB)=$ORDER(PXBSKY(ITEM,0))
+6 ;
+7 IF $GET(IENB)
Begin DoDot:1
+8 FOR PIECE=0,811,812
SET ^TMP("PXK",$JOB,"PRV",PXAK,PIECE,"BEFORE")=$GET(^AUPNVPRV(IENB,PIECE))
End DoDot:1
+9 IF '$TEST
Begin DoDot:1
+10 SET (BEFOR0,BEFOR811,BEFOR812)=""
+11 ;
SETPXKB ;--SET PXK ARRAY BEFORE
+1 SET ^TMP("PXK",$JOB,"PRV",PXAK,0,"BEFORE")=BEFOR0
+2 SET ^TMP("PXK",$JOB,"PRV",PXAK,811,"BEFORE")=BEFOR811
+3 SET ^TMP("PXK",$JOB,"PRV",PXAK,812,"BEFORE")=BEFOR812
+4 SET ^TMP("PXK",$JOB,"PRV",PXAK,"IEN")=""
End DoDot:1
+5 ;
MISC ;--MISCELLANEOUS NODE
+1 ;
+2 QUIT
OTHER ;---ADD OTHER PROVIDERS TO V PROVIDER FOR OTHER ENTRIES
+1 ;
+2 ; generate data, PXBSKY(), about currently filed providers
+3 ;
+4 NEW PXBSKY
+5 IF $GET(PXAVISIT)
DO PRV^PXBGPRV(PXAVISIT,.PXBSKY)
+6 ;
+7 NEW IEN,AFTER0,CNT,PXAK,STOP,FF
+8 SET IEN=""
SET CNT=1000
+9 ;
+10 ;---^TMP("PXAIADDPRV",$J,'IEN')=""
+11 ;
+12 FOR
SET IEN=$ORDER(^TMP("PXAIADDPRV",$JOB,IEN))
SET CNT=CNT+1
IF IEN=""
QUIT
Begin DoDot:1
+13 ;
+14 ;verify if an entry for a provider already exists
+15 ;
+16 SET STOP=0
+17 IF $DATA(^TMP("PXK",$JOB,"PRV"))
SET PXAK=""
Begin DoDot:2
+18 FOR
SET PXAK=$ORDER(^TMP("PXK",$JOB,"PRV",PXAK))
IF PXAK=""
QUIT
Begin DoDot:3
+19 IF +$GET(^TMP("PXK",$JOB,"PRV",PXAK,0,"AFTER"))=IEN
SET STOP=1
End DoDot:3
IF STOP
QUIT
End DoDot:2
IF STOP
QUIT
+20 SET FF="PXBSKY"
FOR
SET FF=$QUERY(@FF)
IF FF=""
QUIT
IF @FF=IEN
SET STOP=1
QUIT
+21 IF STOP
QUIT
+22 ;
+23 SET $PIECE(AFTER0,"^",1)=IEN
+24 SET $PIECE(AFTER0,"^",2)=$PIECE(^AUPNVSIT(PXAVISIT,0),"^",5)
+25 SET $PIECE(AFTER0,"^",3)=PXAVISIT
+26 SET $PIECE(AFTER0,"^",4)="S"
+27 SET $PIECE(AFTER812,"^",2)=$GET(PXAPKG)
+28 SET $PIECE(AFTER812,"^",3)=$GET(PXASOURC)
+29 SET ^TMP("PXK",$JOB,"PRV",CNT,0,"AFTER")=$GET(AFTER0)
+30 SET ^TMP("PXK",$JOB,"PRV",CNT,811,"AFTER")=""
+31 SET ^TMP("PXK",$JOB,"PRV",CNT,812,"AFTER")=$GET(AFTER812)
+32 SET ^TMP("PXK",$JOB,"PRV",CNT,0,"BEFORE")=""
+33 SET ^TMP("PXK",$JOB,"PRV",CNT,811,"BEFORE")=""
+34 SET ^TMP("PXK",$JOB,"PRV",CNT,811,"BEFORE")=""
+35 SET ^TMP("PXK",$JOB,"PRV",CNT,"IEN")=""
End DoDot:1
+36 QUIT
PRIM ;--SET A PROVIDER AS PRIMARY
+1 NEW PXBCNT,PXBKY,PXBSAM,PXBSKY,AFTER0,FPRI,PRVDR,PXASOR
+2 DO PRV^PXBGPRV(PXAVISIT,.PXBSKY,.PXBKY,.PXBSAM,.PXBCNT,.PRVDR,.FPRI)
+3 IF $DATA(PRVDR)
QUIT
+4 IF '$DATA(PXBSKY)
QUIT
+5 ;----ADDED
+6 SET PXASOR=$GET(^TMP("PXK",$JOB,"SOR"))
+7 KILL ^TMP("PXK",$JOB)
+8 SET ^TMP("PXK",$JOB,"SOR")=$GET(PXASOR)
+9 SET ^TMP("PXK",$JOB,"VST",1,"IEN")=PXAVISIT
+10 ;-------
+11 ;
+12 SET $PIECE(AFTER0,"^",1)=$PIECE(^AUPNVPRV($ORDER(PXBSKY(1,0)),0),"^",1)
+13 SET $PIECE(AFTER0,"^",2)=$PIECE(^AUPNVSIT(PXAVISIT,0),"^",5)
+14 SET $PIECE(AFTER0,"^",3)=PXAVISIT
+15 SET $PIECE(AFTER0,"^",4)="P"
+16 SET ^TMP("PXK",$JOB,"PRV",22222,0,"AFTER")=AFTER0
+17 SET ^TMP("PXK",$JOB,"PRV",22222,0,"BEFORE")=$GET(^AUPNVPRV($ORDER(PXBSKY(1,0)),0))
+18 SET ^TMP("PXK",$JOB,"PRV",22222,"IEN")=$ORDER(PXBSKY(1,0))
+19 DO EN1^PXKMAIN
+20 KILL PXRDR
+21 QUIT
