PXCECSTP ;ISL/dee - Used to add a new visit from a secondary credit stop for a main visit in the Update Encounter display ;05/30/2019
;;1.0;PCE PATIENT CARE ENCOUNTER;**22,211**;Aug 12, 1996;Build 454
Q
;
;Line with the line label "FORMAT"
;;Long name~File Number~Node Subscripts~Allow Duplicate entries (not used on visit)~File global name
; 1 2 3 4 5
;
;Following lines:
;;Node~Piece~,Field Number~Edit Label~Display Label~Display Routine~Edit Routine~Help Text for DIR("?")~Set of PXCEKEYS that can Edit~D if Detail Display Only~
; 1 ~ 2 ~ 3 ~ 4 ~ 5 ~ 6 ~ 7 ~ 8 ~ 9 ~ 10
;The Display & Edit routines are for special cases.
;
FORMAT ;;Stop Code~9000010~0,21,150,800,811,812~~^AUPNVSIT
;;0~1~.01~Encounter Date and Time: ~Encounter Date and Time: ~~EVISITDT^PXCEVSIT(1)~~~
;;0~8~.08~Stop Code: ~Stop Code: ~$$DISPLY08^PXCECSTP~EWORKLOD^PXCECSTP~~~B
;;
;
;********************************
;Special cases for display of visit are in PXCEVSIT.
;
;********************************
;Special cases for edit of visit are in PXCEVSIT.
;
EWORKLOD ;
I $P(PXCEAFTR(0),"^",7)="E" D Q
. W !,"Historical Encounters cannot have Stop Codes."
. D WAIT^PXCEHELP
. S (PXCEEND,PXCEQUIT,PXCELOOP)=1
N DIC,DA,PXCANODE
I $P(PXCEAFTR(150),"^",3)="P"!(PXCEFIEN'>0) D
. S PXCEAFTR(0)=$P(PXCEAFTR(0),"^",1)_"^^^^"_$P(PXCEAFTR(0),"^",5,6)_"^^^^^^"_PXCEVIEN_"^^^^^^^^^"_$P(PXCEAFTR(0),"^",21,22)
. S PXCEAFTR(150)="^"_$P(PXCEAFTR(150),"^",2)_"^S"
. S PXCEAFTR(800)=""
. S PXCEAFTR(811)=""
. S PXCEAFTR(812)="^"_PXCEPKG_"^"_PXCESOR
. F PXCENODE=0,21,150,800,811,812 S ^TMP("PXK",$J,"VST",1,PXCENODE,"BEFORE")=""
. S ^TMP("PXK",$J,"VST",1,"IEN")=""
S $P(PXCEAFTR(0),"^",1)=+^AUPNVSIT(PXCEVIEN,0)
EWORKLD2 ;
K DTOUT,DUOUT,DIC
I $P(PXCEAFTR(0),"^",8)]"" D
. N DIERR,PXCEDILF,PXCEINT,PXCEEXT
. S PXCEINT=$P(PXCEAFTR(0),"^",8)
. S Y=+PXCEINT
. S PXCEEXT=$$EXTERNAL^DILFD(PXCEFILE,$P(PXCETEXT,"~",3),"",PXCEINT,"PXCEDILF")
. S DIC("B")=$S('$D(DIERR):PXCEEXT,1:PXCEINT)
S DIC="^DIC(40.7,"
S DIC(0)="AEMQ"
S DIC("S")="I ($P(^(0),U,3)=""""!($P(^(0),U,3)'<$P(PXCEAFTR(0),U)))&($P(^(0),U,2)'=900)"
S DIC("A")=$P(PXCETEXT,"~",4)
D ^DIC
K DIR,DA
I +Y'>0!$D(DTOUT)!$D(DUOUT) S (PXCEEND,PXCEQUIT,PXCELOOP,PXCENOER)=1 Q
S $P(PXCEAFTR(0),"^",8)=+Y
Q
;
;********************************
;Display text for the .01 field which is a Date and Time.
;(Must have is called by ASK^PXCEVFI2 and DEL^PXCEVFI2.)
DISPLY01(PXCEVSIT,PXCEDT) ;
S PXCESC=$P(PXCEVSIT,"^",8)
Q:PXCESC<1 ""
G DISPLAY
;
DISPLY08(PXCESC,PXCEDT) ;
DISPLAY N DIC,DR,DA,DIQ,PXCEDIQ1
S DIC=40.7
S DR=".01;1"
S DA=PXCESC
S DIQ="PXCEDIQ1"
S DIQ(0)="E"
D EN^DIQ1
Q $J($G(PXCEDIQ1(40.7,DA,1,"E")),3)_" "_$G(PXCEDIQ1(40.7,DA,.01,"E"))
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXCECSTP 2977 printed Oct 16, 2024@18:28:39 Page 2
PXCECSTP ;ISL/dee - Used to add a new visit from a secondary credit stop for a main visit in the Update Encounter display ;05/30/2019
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**22,211**;Aug 12, 1996;Build 454
+2 QUIT
+3 ;
+4 ;Line with the line label "FORMAT"
+5 ;;Long name~File Number~Node Subscripts~Allow Duplicate entries (not used on visit)~File global name
+6 ; 1 2 3 4 5
+7 ;
+8 ;Following lines:
+9 ;;Node~Piece~,Field Number~Edit Label~Display Label~Display Routine~Edit Routine~Help Text for DIR("?")~Set of PXCEKEYS that can Edit~D if Detail Display Only~
+10 ; 1 ~ 2 ~ 3 ~ 4 ~ 5 ~ 6 ~ 7 ~ 8 ~ 9 ~ 10
+11 ;The Display & Edit routines are for special cases.
+12 ;
FORMAT ;;Stop Code~9000010~0,21,150,800,811,812~~^AUPNVSIT
+1 ;;0~1~.01~Encounter Date and Time: ~Encounter Date and Time: ~~EVISITDT^PXCEVSIT(1)~~~
+2 ;;0~8~.08~Stop Code: ~Stop Code: ~$$DISPLY08^PXCECSTP~EWORKLOD^PXCECSTP~~~B
+3 ;;
+4 ;
+5 ;********************************
+6 ;Special cases for display of visit are in PXCEVSIT.
+7 ;
+8 ;********************************
+9 ;Special cases for edit of visit are in PXCEVSIT.
+10 ;
EWORKLOD ;
+1 IF $PIECE(PXCEAFTR(0),"^",7)="E"
Begin DoDot:1
+2 WRITE !,"Historical Encounters cannot have Stop Codes."
+3 DO WAIT^PXCEHELP
+4 SET (PXCEEND,PXCEQUIT,PXCELOOP)=1
End DoDot:1
QUIT
+5 NEW DIC,DA,PXCANODE
+6 IF $PIECE(PXCEAFTR(150),"^",3)="P"!(PXCEFIEN'>0)
Begin DoDot:1
+7 SET PXCEAFTR(0)=$PIECE(PXCEAFTR(0),"^",1)_"^^^^"_$PIECE(PXCEAFTR(0),"^",5,6)_"^^^^^^"_PXCEVIEN_"^^^^^^^^^"_$PIECE(PXCEAFTR(0),"^",21,22)
+8 SET PXCEAFTR(150)="^"_$PIECE(PXCEAFTR(150),"^",2)_"^S"
+9 SET PXCEAFTR(800)=""
+10 SET PXCEAFTR(811)=""
+11 SET PXCEAFTR(812)="^"_PXCEPKG_"^"_PXCESOR
+12 FOR PXCENODE=0,21,150,800,811,812
SET ^TMP("PXK",$JOB,"VST",1,PXCENODE,"BEFORE")=""
+13 SET ^TMP("PXK",$JOB,"VST",1,"IEN")=""
End DoDot:1
+14 SET $PIECE(PXCEAFTR(0),"^",1)=+^AUPNVSIT(PXCEVIEN,0)
EWORKLD2 ;
+1 KILL DTOUT,DUOUT,DIC
+2 IF $PIECE(PXCEAFTR(0),"^",8)]""
Begin DoDot:1
+3 NEW DIERR,PXCEDILF,PXCEINT,PXCEEXT
+4 SET PXCEINT=$PIECE(PXCEAFTR(0),"^",8)
+5 SET Y=+PXCEINT
+6 SET PXCEEXT=$$EXTERNAL^DILFD(PXCEFILE,$PIECE(PXCETEXT,"~",3),"",PXCEINT,"PXCEDILF")
+7 SET DIC("B")=$SELECT('$DATA(DIERR):PXCEEXT,1:PXCEINT)
End DoDot:1
+8 SET DIC="^DIC(40.7,"
+9 SET DIC(0)="AEMQ"
+10 SET DIC("S")="I ($P(^(0),U,3)=""""!($P(^(0),U,3)'<$P(PXCEAFTR(0),U)))&($P(^(0),U,2)'=900)"
+11 SET DIC("A")=$PIECE(PXCETEXT,"~",4)
+12 DO ^DIC
+13 KILL DIR,DA
+14 IF +Y'>0!$DATA(DTOUT)!$DATA(DUOUT)
SET (PXCEEND,PXCEQUIT,PXCELOOP,PXCENOER)=1
QUIT
+15 SET $PIECE(PXCEAFTR(0),"^",8)=+Y
+16 QUIT
+17 ;
+18 ;********************************
+19 ;Display text for the .01 field which is a Date and Time.
+20 ;(Must have is called by ASK^PXCEVFI2 and DEL^PXCEVFI2.)
DISPLY01(PXCEVSIT,PXCEDT) ;
+1 SET PXCESC=$PIECE(PXCEVSIT,"^",8)
+2 if PXCESC<1
QUIT ""
+3 GOTO DISPLAY
+4 ;
DISPLY08(PXCESC,PXCEDT) ;
DISPLAY NEW DIC,DR,DA,DIQ,PXCEDIQ1
+1 SET DIC=40.7
+2 SET DR=".01;1"
+3 SET DA=PXCESC
+4 SET DIQ="PXCEDIQ1"
+5 SET DIQ(0)="E"
+6 DO EN^DIQ1
+7 QUIT $JUSTIFY($GET(PXCEDIQ1(40.7,DA,1,"E")),3)_" "_$GET(PXCEDIQ1(40.7,DA,.01,"E"))
+8 ;
