- 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 Mar 13, 2025@21:31:32 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 ;
