- PXCECSTP ;ISL/dee - Used to add a new visit from a secondary credit stop for a main visit in the Update Encounter display ;7/30/96
- ;;1.0;PCE PATIENT CARE ENCOUNTER;**22**;Aug 12, 1996
- 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) ;
- S PXCESC=$P(PXCEVSIT,"^",8)
- Q:PXCESC<1 ""
- G DISPLAY
- ;
- DISPLY08(PXCESC) ;
- 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"))
- ;
- PXCECSTP ;ISL/dee - Used to add a new visit from a secondary credit stop for a main visit in the Update Encounter display ;7/30/96
- +1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**22**;Aug 12, 1996
- +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) ;
- +1 SET PXCESC=$PIECE(PXCEVSIT,"^",8)
- +2 IF PXCESC<1
- QUIT ""
- +3 GOTO DISPLAY
- +4 ;
- DISPLY08(PXCESC) ;
- 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 ;
