| [613] | 1 | 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
|
|---|
| 2 | ;;1.0;PCE PATIENT CARE ENCOUNTER;**22**;Aug 12, 1996
|
|---|
| 3 | Q
|
|---|
| 4 | ;
|
|---|
| 5 | ;Line with the line label "FORMAT"
|
|---|
| 6 | ;;Long name~File Number~Node Subscripts~Allow Duplicate entries (not used on visit)~File global name
|
|---|
| 7 | ; 1 2 3 4 5
|
|---|
| 8 | ;
|
|---|
| 9 | ;Following lines:
|
|---|
| 10 | ;;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~
|
|---|
| 11 | ; 1 ~ 2 ~ 3 ~ 4 ~ 5 ~ 6 ~ 7 ~ 8 ~ 9 ~ 10
|
|---|
| 12 | ;The Display & Edit routines are for special cases.
|
|---|
| 13 | ;
|
|---|
| 14 | FORMAT ;;Stop Code~9000010~0,21,150,800,811,812~~^AUPNVSIT
|
|---|
| 15 | ;;0~1~.01~Encounter Date and Time: ~Encounter Date and Time: ~~EVISITDT^PXCEVSIT(1)~~~
|
|---|
| 16 | ;;0~8~.08~Stop Code: ~Stop Code: ~$$DISPLY08^PXCECSTP~EWORKLOD^PXCECSTP~~~B
|
|---|
| 17 | ;;
|
|---|
| 18 | ;
|
|---|
| 19 | ;********************************
|
|---|
| 20 | ;Special cases for display of visit are in PXCEVSIT.
|
|---|
| 21 | ;
|
|---|
| 22 | ;********************************
|
|---|
| 23 | ;Special cases for edit of visit are in PXCEVSIT.
|
|---|
| 24 | ;
|
|---|
| 25 | EWORKLOD ;
|
|---|
| 26 | I $P(PXCEAFTR(0),"^",7)="E" D Q
|
|---|
| 27 | . W !,"Historical Encounters cannot have Stop Codes."
|
|---|
| 28 | . D WAIT^PXCEHELP
|
|---|
| 29 | . S (PXCEEND,PXCEQUIT,PXCELOOP)=1
|
|---|
| 30 | N DIC,DA,PXCANODE
|
|---|
| 31 | I $P(PXCEAFTR(150),"^",3)="P"!(PXCEFIEN'>0) D
|
|---|
| 32 | . S PXCEAFTR(0)=$P(PXCEAFTR(0),"^",1)_"^^^^"_$P(PXCEAFTR(0),"^",5,6)_"^^^^^^"_PXCEVIEN_"^^^^^^^^^"_$P(PXCEAFTR(0),"^",21,22)
|
|---|
| 33 | . S PXCEAFTR(150)="^"_$P(PXCEAFTR(150),"^",2)_"^S"
|
|---|
| 34 | . S PXCEAFTR(800)=""
|
|---|
| 35 | . S PXCEAFTR(811)=""
|
|---|
| 36 | . S PXCEAFTR(812)="^"_PXCEPKG_"^"_PXCESOR
|
|---|
| 37 | . F PXCENODE=0,21,150,800,811,812 S ^TMP("PXK",$J,"VST",1,PXCENODE,"BEFORE")=""
|
|---|
| 38 | . S ^TMP("PXK",$J,"VST",1,"IEN")=""
|
|---|
| 39 | S $P(PXCEAFTR(0),"^",1)=+^AUPNVSIT(PXCEVIEN,0)
|
|---|
| 40 | EWORKLD2 ;
|
|---|
| 41 | K DTOUT,DUOUT,DIC
|
|---|
| 42 | I $P(PXCEAFTR(0),"^",8)]"" D
|
|---|
| 43 | . N DIERR,PXCEDILF,PXCEINT,PXCEEXT
|
|---|
| 44 | . S PXCEINT=$P(PXCEAFTR(0),"^",8)
|
|---|
| 45 | . S Y=+PXCEINT
|
|---|
| 46 | . S PXCEEXT=$$EXTERNAL^DILFD(PXCEFILE,$P(PXCETEXT,"~",3),"",PXCEINT,"PXCEDILF")
|
|---|
| 47 | . S DIC("B")=$S('$D(DIERR):PXCEEXT,1:PXCEINT)
|
|---|
| 48 | S DIC="^DIC(40.7,"
|
|---|
| 49 | S DIC(0)="AEMQ"
|
|---|
| 50 | S DIC("S")="I ($P(^(0),U,3)=""""!($P(^(0),U,3)'<$P(PXCEAFTR(0),U)))&($P(^(0),U,2)'=900)"
|
|---|
| 51 | S DIC("A")=$P(PXCETEXT,"~",4)
|
|---|
| 52 | D ^DIC
|
|---|
| 53 | K DIR,DA
|
|---|
| 54 | I +Y'>0!$D(DTOUT)!$D(DUOUT) S (PXCEEND,PXCEQUIT,PXCELOOP,PXCENOER)=1 Q
|
|---|
| 55 | S $P(PXCEAFTR(0),"^",8)=+Y
|
|---|
| 56 | Q
|
|---|
| 57 | ;
|
|---|
| 58 | ;********************************
|
|---|
| 59 | ;Display text for the .01 field which is a Date and Time.
|
|---|
| 60 | ;(Must have is called by ASK^PXCEVFI2 and DEL^PXCEVFI2.)
|
|---|
| 61 | DISPLY01(PXCEVSIT) ;
|
|---|
| 62 | S PXCESC=$P(PXCEVSIT,"^",8)
|
|---|
| 63 | Q:PXCESC<1 ""
|
|---|
| 64 | G DISPLAY
|
|---|
| 65 | ;
|
|---|
| 66 | DISPLY08(PXCESC) ;
|
|---|
| 67 | DISPLAY N DIC,DR,DA,DIQ,PXCEDIQ1
|
|---|
| 68 | S DIC=40.7
|
|---|
| 69 | S DR=".01;1"
|
|---|
| 70 | S DA=PXCESC
|
|---|
| 71 | S DIQ="PXCEDIQ1"
|
|---|
| 72 | S DIQ(0)="E"
|
|---|
| 73 | D EN^DIQ1
|
|---|
| 74 | Q $J($G(PXCEDIQ1(40.7,DA,1,"E")),3)_" "_$G(PXCEDIQ1(40.7,DA,.01,"E"))
|
|---|
| 75 | ;
|
|---|
