PXBGSTP ;ISL/JVS - GATHER STOP CODES FROM SECONDARY VISITS ;7/24/96 08:15
;;1.0;PCE PATIENT CARE ENCOUNTER;;Aug 12, 1996
;
;
;
STP(PXBVST) ;--Gather the stop codes from the secondary visits
;
;
;PXBVST=PRIMARY VISIT
;--Validate A primary visit is sent in
I $P($G(^AUPNVSIT(PXBVST,150)),"^",3)'="P" S PXBCNT=0 Q
;
;--NEW variables
N IEN,STP,STOPCODE,AMISCODE,INDATEI,INDATEE,PXBC
N D0,D1,DA,DDH,DIG,DIH,DIQ,DR
;--KILL variables
K ^TMP("PXBU",$J),VAUGHN,PXBKY,PXBSAM,PXBSKY,GROUP
;--CREATE tmp global
I $D(^AUPNVSIT("AD",PXBVST)) D
.S IEN=0 F S IEN=$O(^AUPNVSIT("AD",PXBVST,IEN)) Q:IEN'>0 D
..I '$P(^AUPNVSIT(IEN,0),"^",8) Q
..I $P(^AUPNVSIT(IEN,150),"^",3)="C" Q
..S ^TMP("PXBU",$J,"STP",IEN)=""
;
;
A ;--Set array with the STOP CODES from the visits
I $D(^TMP("PXBU",$J,"STP")) D
.S IEN=0 F S IEN=$O(^TMP("PXBU",$J,"STP",IEN)) Q:IEN'>0 D
..S DIC=9000010,DR=.08,DA=IEN,DIQ="VAUGHN(",DIQ(0)="EI" D EN^DIQ1
..S STOPCODE=$G(VAUGHN(9000010,DA,.08,"E"))
..S STOPIEN=$G(VAUGHN(9000010,DA,.08,"I"))
..S DIC=40.7,DR="1;2",DA=STOPIEN,DIQ="VAUGHN(",DIQ(0)="EI" D EN^DIQ1
..S AMISCODE=$G(VAUGHN(40.7,DA,1,"E"))
..I $G(AMISCODE)']"" Q
..S INDATEI=$G(VAUGHN(40.7,DA,2,"I"))
..S INDATEE=$G(VAUGHN(40.7,DA,2,"E"))
..S GROUP=AMISCODE_"^"_STOPCODE_"^"_INDATEI_"^"_INDATEE
..S STP(AMISCODE,IEN)=GROUP
;
;
B ;--ADD Line Numbers
I $D(STP) D
.S PXBC=0,STP="" F S STP=$O(STP(STP)) Q:STP="" D
..S IEN=0 F S IEN=$O(STP(STP,IEN)) Q:IEN="" S PXBC=PXBC+1 D
...S PXBKY(STP,PXBC)=$G(STP(STP,IEN)),PXBSAM(PXBC)=$G(STP(STP,IEN))
...S PXBSKY(PXBC,IEN)=""
F ;--FINISH UP THE VARIABLES
K ^TMP("PXBU",$J),VAUGHN
S PXBCNT=+$G(PXBC)
CREDIT ;--FIND THE MAIN CREDIT STOP FROM MAIN VISIT
N CLIPTR,TANA,CRESTP
S CLIPTR=$P($G(^AUPNVSIT(PXBVST,0)),"^",22) Q:CLIPTR']""
S CRESTP=$P($G(^SC(CLIPTR,0)),"^",7) Q:CRESTP']""
;
;
S DIC=40.7,DR=".01;1",DA=CRESTP,DIQ="TANA(",DIQ(0)="EI" D EN^DIQ1
S CREDIT=TANA(40.7,CRESTP,1,"E")_"--"_TANA(40.7,CRESTP,.01,"E")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXBGSTP 2034 printed Apr 09, 2024@21:32:17 Page 2
PXBGSTP ;ISL/JVS - GATHER STOP CODES FROM SECONDARY VISITS ;7/24/96 08:15
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;;Aug 12, 1996
+2 ;
+3 ;
+4 ;
STP(PXBVST) ;--Gather the stop codes from the secondary visits
+1 ;
+2 ;
+3 ;PXBVST=PRIMARY VISIT
+4 ;--Validate A primary visit is sent in
+5 IF $PIECE($GET(^AUPNVSIT(PXBVST,150)),"^",3)'="P"
SET PXBCNT=0
QUIT
+6 ;
+7 ;--NEW variables
+8 NEW IEN,STP,STOPCODE,AMISCODE,INDATEI,INDATEE,PXBC
+9 NEW D0,D1,DA,DDH,DIG,DIH,DIQ,DR
+10 ;--KILL variables
+11 KILL ^TMP("PXBU",$JOB),VAUGHN,PXBKY,PXBSAM,PXBSKY,GROUP
+12 ;--CREATE tmp global
+13 IF $DATA(^AUPNVSIT("AD",PXBVST))
Begin DoDot:1
+14 SET IEN=0
FOR
SET IEN=$ORDER(^AUPNVSIT("AD",PXBVST,IEN))
if IEN'>0
QUIT
Begin DoDot:2
+15 IF '$PIECE(^AUPNVSIT(IEN,0),"^",8)
QUIT
+16 IF $PIECE(^AUPNVSIT(IEN,150),"^",3)="C"
QUIT
+17 SET ^TMP("PXBU",$JOB,"STP",IEN)=""
End DoDot:2
End DoDot:1
+18 ;
+19 ;
A ;--Set array with the STOP CODES from the visits
+1 IF $DATA(^TMP("PXBU",$JOB,"STP"))
Begin DoDot:1
+2 SET IEN=0
FOR
SET IEN=$ORDER(^TMP("PXBU",$JOB,"STP",IEN))
if IEN'>0
QUIT
Begin DoDot:2
+3 SET DIC=9000010
SET DR=.08
SET DA=IEN
SET DIQ="VAUGHN("
SET DIQ(0)="EI"
DO EN^DIQ1
+4 SET STOPCODE=$GET(VAUGHN(9000010,DA,.08,"E"))
+5 SET STOPIEN=$GET(VAUGHN(9000010,DA,.08,"I"))
+6 SET DIC=40.7
SET DR="1;2"
SET DA=STOPIEN
SET DIQ="VAUGHN("
SET DIQ(0)="EI"
DO EN^DIQ1
+7 SET AMISCODE=$GET(VAUGHN(40.7,DA,1,"E"))
+8 IF $GET(AMISCODE)']""
QUIT
+9 SET INDATEI=$GET(VAUGHN(40.7,DA,2,"I"))
+10 SET INDATEE=$GET(VAUGHN(40.7,DA,2,"E"))
+11 SET GROUP=AMISCODE_"^"_STOPCODE_"^"_INDATEI_"^"_INDATEE
+12 SET STP(AMISCODE,IEN)=GROUP
End DoDot:2
End DoDot:1
+13 ;
+14 ;
B ;--ADD Line Numbers
+1 IF $DATA(STP)
Begin DoDot:1
+2 SET PXBC=0
SET STP=""
FOR
SET STP=$ORDER(STP(STP))
if STP=""
QUIT
Begin DoDot:2
+3 SET IEN=0
FOR
SET IEN=$ORDER(STP(STP,IEN))
if IEN=""
QUIT
SET PXBC=PXBC+1
Begin DoDot:3
+4 SET PXBKY(STP,PXBC)=$GET(STP(STP,IEN))
SET PXBSAM(PXBC)=$GET(STP(STP,IEN))
+5 SET PXBSKY(PXBC,IEN)=""
End DoDot:3
End DoDot:2
End DoDot:1
F ;--FINISH UP THE VARIABLES
+1 KILL ^TMP("PXBU",$JOB),VAUGHN
+2 SET PXBCNT=+$GET(PXBC)
CREDIT ;--FIND THE MAIN CREDIT STOP FROM MAIN VISIT
+1 NEW CLIPTR,TANA,CRESTP
+2 SET CLIPTR=$PIECE($GET(^AUPNVSIT(PXBVST,0)),"^",22)
if CLIPTR']""
QUIT
+3 SET CRESTP=$PIECE($GET(^SC(CLIPTR,0)),"^",7)
if CRESTP']""
QUIT
+4 ;
+5 ;
+6 SET DIC=40.7
SET DR=".01;1"
SET DA=CRESTP
SET DIQ="TANA("
SET DIQ(0)="EI"
DO EN^DIQ1
+7 SET CREDIT=TANA(40.7,CRESTP,1,"E")_"--"_TANA(40.7,CRESTP,.01,"E")
+8 QUIT
+9 ;
