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 | ;
|
---|