source: WorldVistAEHR/trunk/r/PCE_PATIENT_CARE_ENCOUNTER-AUTN-EFDP-PX-VSIT--PXRM/PXCEHELP.m@ 975

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

initial load of WorldVistAEHR

File size: 3.4 KB
Line 
1PXCEHELP ;ISL/dee - Used for help on input ; 5/7/03 3:38pm
2 ;;1.0;PCE PATIENT CARE ENCOUNTER;**5,121**;Aug 12, 1996
3 ;;
4 Q
5 ;
6HELP ;
7 D:$G(PXCEHLST)'=PXCECATS INTRFACE(PXCEHLOC,PXCECATS,"PXCEHLST")
8 Q:$G(PXCEHLST)'=PXCECATS
9 N PXCEINDX,PXCECODE,Y
10 S Y=1
11 S PXCECODE=((PXCEHLST="POV")!(PXCEHLST="CPT"))
12 W !
13 S PXCEINDX=0
14 F S PXCEINDX=$O(PXCEHLST(PXCEINDX)) Q:'PXCEINDX D Q:'Y
15 . I $P(PXCEHLST(PXCEINDX),"^",1)="" W !,?5,$P(PXCEHLST(PXCEINDX),"^",2)
16 . E I PXCECODE W !,$P(PXCEHLST(PXCEINDX),"^",1),?10,$P(PXCEHLST(PXCEINDX),"^",2)
17 . E W !,?10,$P(PXCEHLST(PXCEINDX),"^",2)
18 . I '(PXCEINDX#(IOSL-5)) D PAUSE
19 I Y,(PXCEINDX#(IOSL-5)) D PAUSE
20 W !
21 Q
22 ;
23INTRFACE(PXCEHLOC,PXCECATS,PXCELIST) ;
24 ;Calls the AICS routine to get the selection list for one
25 ; package interface file.
26 K @PXCELIST
27 N PXCEINTF,PXCEDT
28 S PXCEINTF=$P($T(INTRFACE^@("PXCE"_PXCECATS)),";;",2)
29 Q:PXCEINTF=""
30 S PXCEDT=+^TMP("PXK",$J,"VST",1,0,"AFTER")
31 D GETLST^IBDF18A(PXCEHLOC,PXCEINTF,PXCELIST,,,,PXCEDT)
32 Q:'$G(@PXCELIST@(0))
33 S @PXCELIST=PXCECATS
34 Q
35 ;
36NEWENC ;Displays warning before adding a new historical encounter.
37 W !!,"This will create a historical encounter for documenting a clinical encounter"
38 W !,"only and will not be used by Scheduling, Billing or Workload credit."
39 D PAUSE
40 Q
41 ;
42PAUSE ;
43 N DIR
44 W !
45 S DIR(0)="E"
46 D ^DIR
47 W !
48 Q
49 ;
50WAIT ;
51 N DIR
52 W !
53 S DIR("A")="Enter RETURN to continue "
54 S DIR(0)="EA"
55 D ^DIR
56 W !
57 Q
58 ;
59 ;from TIUHELP ;ISL/JER - On-line help library ;
60 ;;pre1.0;Text Integration Utilities;;Jul 24, 1995
61PROTOCOL ; Help for protocols
62 N DIRUT,DTOUT,DUOUT,TIUX,ORU,ORUPRMT,VALMDDF,VALMPGE S TIUX=X
63 D FULL^VALM1
64 I TIUX="?" D G PROTX
65 . D DISP^XQORM1 W !!,"Enter selection by typing the name, or abbreviation.",!,"Enter '??' for additional details.",!
66 . I TIUX="?" W:$$STOP ""
67 I TIUX="??" D MENU(XQORNOD) I $D(DIROUT) S (XQORQUIT,XQORPOP)=1 Q
68PROTX S VALMBCK="R"
69 Q
70MENU(XQORNOD) ; Unwind protocol menus for help
71 N TIUSEQ,TIUI,TIUJ D CLEAR^VALM1
72 W:$$CONTINUE "Valid selections are:",!
73 S TIUI=0 F S TIUI=$O(^ORD(101,+XQORNOD,10,TIUI)) Q:+TIUI'>0 D
74 . S TIUJ=+$P($G(^ORD(101,+XQORNOD,10,TIUI,0)),U,3) S:$D(TIUSEQ(TIUJ)) TIUJ=TIUJ+.1
75 . S TIUSEQ(TIUJ)=+$P(^ORD(101,+XQORNOD,10,TIUI,0),U)
76 S TIUI=0 F S TIUI=$O(TIUSEQ(TIUI)) Q:+TIUI'>0!$D(DIRUT) D
77 . I $D(^ORD(101,+TIUSEQ(TIUI),0)) D ITEM(+TIUSEQ(TIUI),1)
78 Q
79ITEM(XQORNOD,TAB) ; Show descriptions of items
80 N TIUI
81 Q:$P($G(^ORD(101,+XQORNOD,0)),U,2)']""
82 W:$$CONTINUE ?+$G(TAB),$G(IOINHI),$$UPPER($P($G(^ORD(101,+XQORNOD,0)),U,2)),$G(IOINORM),!
83 I $D(DIRUT) Q
84 S TIUI=0 F S TIUI=$O(^ORD(101,+XQORNOD,1,TIUI)) Q:+TIUI'>0!$D(DIRUT) D
85 . W:$$CONTINUE ?(TAB+2),$G(^ORD(101,+XQORNOD,1,TIUI,0)),! Q:$D(DIRUT)
86 ;S TIUI=0 F S TIUI=$O(^ORD(101,+XQORNOD,10,TIUI)) Q:+TIUI'>0 D
87 ;. D ITEM(+$G(^ORD(101,+XQORNOD,10,+TIUI,0))_";ORD(101,",3)
88 Q
89 ;
90CONTINUE() ; Pagination control
91 N Y
92 I $Y<(IOSL-2) S Y=1 G CONTX
93 S Y=$$STOP("",1) W:+Y @IOF,!
94CONTX Q Y
95 ;
96STOP(PROMPT,SCROLL) ; Call DIR at bottom of screen
97 N DIR,DA,X,Y
98 I $E(IOST)'="C" S Y="" G STOPX
99 I +$G(SCROLL),(IOSL>($Y+5)) F W ! Q:IOSL<($Y+6)
100 S DIR(0)="FO^1:1",DIR("A")=$S($G(PROMPT)]"":PROMPT,1:"Press RETURN to continue or '^' to exit")
101 S DIR("?")="Enter '^' to quit present action or '^^' to quit to menu"
102 D ^DIR I $D(DIRUT),(Y="") K DIRUT
103 S Y=$S(Y="^":0,Y="^^":0,$D(DTOUT):"",Y="":1,1:1_U_Y)
104STOPX Q Y
105 ;
106UPPER(X) ; Convert lower case X to UPPER CASE
107 Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
108 ;
Note: See TracBrowser for help on using the repository browser.