- PXUTLSTP ;ISL/dee,ESW - Utility routine used by PCE to add/edit/delete stop code visits ; 10/11/2017
- ;;1.0;PCE PATIENT CARE ENCOUNTER;**1,96,166,197,211**;Aug 12, 1996;Build 454
- Q
- ;
- STOPCODE(PXUTSOR,PXUTSTOP,PXUTVST,PXUTSVST) ;Makes or edits visit to create the secondary visit for the credit stops
- ; Parameters
- ; PXUTSOR IEN of the Data source
- ; PXUTSTOP Pointer to Stop Code OR "@" if delete the secondary visit
- ; PXUTVST Main visit
- ; PXUTSVST Secondary visit
- ; if there is not one then create one
- ; if there is one then this is an edit or delete
- ;
- ; Returns the pointer to the secondary visit
- ; or 0 if the secondary visit was deleted
- ; or -1 if the secondary visit could not be deleted
- ; or null if visit tracking did not create the visit
- ;
- ;
- D EVENT^PXKMAIN
- N PXUAFTER,PXUTNODE,PXUTRET,PXKERROR,PXUTEXIT
- K ^TMP("PXK",$J)
- S PXUTEXIT=0
- ;
- I $G(PXUTSVST)>0 D Q:PXUTEXIT -1
- . I PXUTSTOP="@" D
- ..;--ENTERED TO TRY TO KILL STOP CODES
- DELETE ..;If stop code has to be killed on credit stop code visit then
- ..; the whole visit has to be killed with and pointing to it
- ..; outpatient encounter.
- .. F PXUTNODE=0,21,150,800,811,812 D
- ... S (^TMP("PXK",$J,"VST",1,PXUTNODE,"AFTER"),^TMP("PXK",$J,"VST",1,PXUTNODE,"BEFORE"))=$G(^AUPNVSIT(PXUTSVST,PXUTNODE))
- .. S $P(^TMP("PXK",$J,"VST",1,0,"AFTER"),"^",8)="@"
- .. S ^TMP("PXK",$J,"VST",1,"IEN")=PXUTSVST
- ..; Verify if this is really credit stop visit with only 1 dependent
- ..; entry that is outpatient encounter.
- .. I $$DEC^VSITKIL(PXUTVST)>2 Q ; do not kill the secondary, visit will stay PX/197
- .. ;I $$DEC^VSITKIL(PXUTSVST,0)<2,$P($G(^AUPNVSIT(PXUTSVST,150)),U,3)="C" D ;PX/96;commented PX/197
- .. I '$D(^SCE("AVSIT",PXUTVST)) Q ; do not kill
- .. S ^TMP("PXK",$J,"VST",1,0,"AFTER")="@"
- ..; Find Outpatient Encounter to take care of
- .. N SDOEP
- .. D LISTVST^SDOERPC(.SDOEP,PXUTVST)
- .. S SDOEP=$P(SDOEP,")")_","_""""""_")"
- .. S SDOEP=$O(@SDOEP) D CHLD^SDCODEL(SDOEP,0)
- . E D
- EDIT .. F PXUTNODE=0,21,150,800,811,812 D
- ... S (^TMP("PXK",$J,"VST",1,PXUTNODE,"AFTER"),^TMP("PXK",$J,"VST",1,PXUTNODE,"BEFORE"))=$G(^AUPNVSIT(PXUTSVST,PXUTNODE))
- .. S $P(^TMP("PXK",$J,"VST",1,0,"AFTER"),"^",8)=PXUTSTOP
- .. S ^TMP("PXK",$J,"VST",1,"IEN")=PXUTSVST
- ;
- E I $G(PXUTVST)>0 D
- CREATE . F PXUTNODE=150,800,811 D
- .. S ^TMP("PXK",$J,"VST",1,PXUTNODE,"AFTER")=""
- .. S ^TMP("PXK",$J,"VST",1,PXUTNODE,"BEFORE")=""
- . S ^TMP("PXK",$J,"VST",1,21,"AFTER")=$G(^AUPNVSIT(PXUTVST,21))
- . S ^TMP("PXK",$J,"VST",1,21,"BEFORE")=""
- . S ^TMP("PXK",$J,"VST",1,150,"AFTER")="^^S"
- . S ^TMP("PXK",$J,"VST",1,150,"BEFORE")=""
- . S ^TMP("PXK",$J,"VST",1,812,"AFTER")="^^"_PXUTSOR
- . S ^TMP("PXK",$J,"VST",1,812,"BEFORE")=""
- . S PXUAFTER=$G(^AUPNVSIT(PXUTVST,0))
- . S ^TMP("PXK",$J,"VST",1,0,"AFTER")=$P(PXUAFTER,"^",1)_"^^^^"_$P(PXUAFTER,"^",5,6)_"^^"_PXUTSTOP_"^^^^"_PXUTVST_"^^^^^^^^^"_$P(PXUAFTER,"^",21,22)
- . S ^TMP("PXK",$J,"VST",1,0,"BEFORE")=""
- . S ^TMP("PXK",$J,"VST",1,"IEN")=""
- E Q -1
- ;
- S ^TMP("PXK",$J,"SOR")=PXUTSOR
- D EN1^PXKMAIN
- S PXUTRET=^TMP("PXK",$J,"VST",1,"IEN")
- D EVENT^PXKMAIN
- K ^TMP("PXK",$J)
- I PXUTRET>0,$G(PXUTSVST)>0,PXUTSTOP="@" D
- . N PXUTKILL
- . S PXUTKILL=$$KILL^VSITKIL(PXUTSVST)
- . S:'PXUTKILL PXUTRET=0 ; visit was killed
- D MODIFIED^VSIT(PXUTVST)
- Q PXUTRET
- ;
- ;
- ;
- ;
- DEAD(VSIT) ;---*** ADDED IN ALBANY BY VAUGHN
- ;--TO KILL LEFT OVER CREDIT STOP ENTRY THAT IS NOT DELETED
- ;-added next line to quit
- Q:$G(VSIT)<1
- N DEAD,CHILD
- S CHILD=0 F S CHILD=$O(^AUPNVSIT("AD",VSIT,CHILD)) Q:CHILD="" D
- .I $P($G(^AUPNVSIT(CHILD,0)),"^",8)="",$P($G(^AUPNVSIT(CHILD,0)),"^",9)<1,$P($G(^AUPNVSIT(CHILD,150)),"^",3)="C" S DEAD=$$KILL^VSITKIL(CHILD)
- ;-----END OF ADDED CODE VAUGHN----
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXUTLSTP 3825 printed Feb 18, 2025@23:57:57 Page 2
- PXUTLSTP ;ISL/dee,ESW - Utility routine used by PCE to add/edit/delete stop code visits ; 10/11/2017
- +1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**1,96,166,197,211**;Aug 12, 1996;Build 454
- +2 QUIT
- +3 ;
- STOPCODE(PXUTSOR,PXUTSTOP,PXUTVST,PXUTSVST) ;Makes or edits visit to create the secondary visit for the credit stops
- +1 ; Parameters
- +2 ; PXUTSOR IEN of the Data source
- +3 ; PXUTSTOP Pointer to Stop Code OR "@" if delete the secondary visit
- +4 ; PXUTVST Main visit
- +5 ; PXUTSVST Secondary visit
- +6 ; if there is not one then create one
- +7 ; if there is one then this is an edit or delete
- +8 ;
- +9 ; Returns the pointer to the secondary visit
- +10 ; or 0 if the secondary visit was deleted
- +11 ; or -1 if the secondary visit could not be deleted
- +12 ; or null if visit tracking did not create the visit
- +13 ;
- +14 ;
- +15 DO EVENT^PXKMAIN
- +16 NEW PXUAFTER,PXUTNODE,PXUTRET,PXKERROR,PXUTEXIT
- +17 KILL ^TMP("PXK",$JOB)
- +18 SET PXUTEXIT=0
- +19 ;
- +20 IF $GET(PXUTSVST)>0
- Begin DoDot:1
- +21 IF PXUTSTOP="@"
- Begin DoDot:2
- +22 ;--ENTERED TO TRY TO KILL STOP CODES
- DELETE ;If stop code has to be killed on credit stop code visit then
- +1 ; the whole visit has to be killed with and pointing to it
- +2 ; outpatient encounter.
- +3 FOR PXUTNODE=0,21,150,800,811,812
- Begin DoDot:3
- +4 SET (^TMP("PXK",$JOB,"VST",1,PXUTNODE,"AFTER"),^TMP("PXK",$JOB,"VST",1,PXUTNODE,"BEFORE"))=$GET(^AUPNVSIT(PXUTSVST,PXUTNODE))
- End DoDot:3
- +5 SET $PIECE(^TMP("PXK",$JOB,"VST",1,0,"AFTER"),"^",8)="@"
- +6 SET ^TMP("PXK",$JOB,"VST",1,"IEN")=PXUTSVST
- +7 ; Verify if this is really credit stop visit with only 1 dependent
- +8 ; entry that is outpatient encounter.
- +9 ; do not kill the secondary, visit will stay PX/197
- IF $$DEC^VSITKIL(PXUTVST)>2
- QUIT
- +10 ;I $$DEC^VSITKIL(PXUTSVST,0)<2,$P($G(^AUPNVSIT(PXUTSVST,150)),U,3)="C" D ;PX/96;commented PX/197
- +11 ; do not kill
- IF '$DATA(^SCE("AVSIT",PXUTVST))
- QUIT
- +12 SET ^TMP("PXK",$JOB,"VST",1,0,"AFTER")="@"
- +13 ; Find Outpatient Encounter to take care of
- +14 NEW SDOEP
- +15 DO LISTVST^SDOERPC(.SDOEP,PXUTVST)
- +16 SET SDOEP=$PIECE(SDOEP,")")_","_""""""_")"
- +17 SET SDOEP=$ORDER(@SDOEP)
- DO CHLD^SDCODEL(SDOEP,0)
- End DoDot:2
- +18 IF '$TEST
- Begin DoDot:2
- EDIT FOR PXUTNODE=0,21,150,800,811,812
- Begin DoDot:3
- +1 SET (^TMP("PXK",$JOB,"VST",1,PXUTNODE,"AFTER"),^TMP("PXK",$JOB,"VST",1,PXUTNODE,"BEFORE"))=$GET(^AUPNVSIT(PXUTSVST,PXUTNODE))
- End DoDot:3
- +2 SET $PIECE(^TMP("PXK",$JOB,"VST",1,0,"AFTER"),"^",8)=PXUTSTOP
- +3 SET ^TMP("PXK",$JOB,"VST",1,"IEN")=PXUTSVST
- End DoDot:2
- End DoDot:1
- if PXUTEXIT
- QUIT -1
- +4 ;
- +5 IF '$TEST
- IF $GET(PXUTVST)>0
- Begin DoDot:1
- CREATE FOR PXUTNODE=150,800,811
- Begin DoDot:2
- +1 SET ^TMP("PXK",$JOB,"VST",1,PXUTNODE,"AFTER")=""
- +2 SET ^TMP("PXK",$JOB,"VST",1,PXUTNODE,"BEFORE")=""
- End DoDot:2
- +3 SET ^TMP("PXK",$JOB,"VST",1,21,"AFTER")=$GET(^AUPNVSIT(PXUTVST,21))
- +4 SET ^TMP("PXK",$JOB,"VST",1,21,"BEFORE")=""
- +5 SET ^TMP("PXK",$JOB,"VST",1,150,"AFTER")="^^S"
- +6 SET ^TMP("PXK",$JOB,"VST",1,150,"BEFORE")=""
- +7 SET ^TMP("PXK",$JOB,"VST",1,812,"AFTER")="^^"_PXUTSOR
- +8 SET ^TMP("PXK",$JOB,"VST",1,812,"BEFORE")=""
- +9 SET PXUAFTER=$GET(^AUPNVSIT(PXUTVST,0))
- +10 SET ^TMP("PXK",$JOB,"VST",1,0,"AFTER")=$PIECE(PXUAFTER,"^",1)_"^^^^"_$PIECE(PXUAFTER,"^",5,6)_"^^"_PXUTSTOP_"^^^^"_PXUTVST_"^^^^^^^^^"_$PIECE(PXUAFTER,"^",21,22)
- +11 SET ^TMP("PXK",$JOB,"VST",1,0,"BEFORE")=""
- +12 SET ^TMP("PXK",$JOB,"VST",1,"IEN")=""
- End DoDot:1
- +13 IF '$TEST
- QUIT -1
- +14 ;
- +15 SET ^TMP("PXK",$JOB,"SOR")=PXUTSOR
- +16 DO EN1^PXKMAIN
- +17 SET PXUTRET=^TMP("PXK",$JOB,"VST",1,"IEN")
- +18 DO EVENT^PXKMAIN
- +19 KILL ^TMP("PXK",$JOB)
- +20 IF PXUTRET>0
- IF $GET(PXUTSVST)>0
- IF PXUTSTOP="@"
- Begin DoDot:1
- +21 NEW PXUTKILL
- +22 SET PXUTKILL=$$KILL^VSITKIL(PXUTSVST)
- +23 ; visit was killed
- if 'PXUTKILL
- SET PXUTRET=0
- End DoDot:1
- +24 DO MODIFIED^VSIT(PXUTVST)
- +25 QUIT PXUTRET
- +26 ;
- +27 ;
- +28 ;
- +29 ;
- DEAD(VSIT) ;---*** ADDED IN ALBANY BY VAUGHN
- +1 ;--TO KILL LEFT OVER CREDIT STOP ENTRY THAT IS NOT DELETED
- +2 ;-added next line to quit
- +3 if $GET(VSIT)<1
- QUIT
- +4 NEW DEAD,CHILD
- +5 SET CHILD=0
- FOR
- SET CHILD=$ORDER(^AUPNVSIT("AD",VSIT,CHILD))
- if CHILD=""
- QUIT
- Begin DoDot:1
- +6 IF $PIECE($GET(^AUPNVSIT(CHILD,0)),"^",8)=""
- IF $PIECE($GET(^AUPNVSIT(CHILD,0)),"^",9)<1
- IF $PIECE($GET(^AUPNVSIT(CHILD,150)),"^",3)="C"
- SET DEAD=$$KILL^VSITKIL(CHILD)
- End DoDot:1
- +7 ;-----END OF ADDED CODE VAUGHN----
- +8 ;