source: FOIAVistA/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXCECSTP.m@ 1800

Last change on this file since 1800 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.8 KB
Line 
1PXCECSTP ;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 ;
14FORMAT ;;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 ;
25EWORKLOD ;
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)
40EWORKLD2 ;
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.)
61DISPLY01(PXCEVSIT) ;
62 S PXCESC=$P(PXCEVSIT,"^",8)
63 Q:PXCESC<1 ""
64 G DISPLAY
65 ;
66DISPLY08(PXCESC) ;
67DISPLAY 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 ;
Note: See TracBrowser for help on using the repository browser.