PXCEHELP ;ISL/dee - Used for help on input ;9/24/96
;;1.0;PCE PATIENT CARE ENCOUNTER;**5**;Aug 12, 1996
;;
Q
;
HELP ;
D:$G(PXCEHLST)'=PXCECATS INTRFACE(PXCEHLOC,PXCECATS,"PXCEHLST")
Q:$G(PXCEHLST)'=PXCECATS
N PXCEINDX,PXCECODE,Y
S Y=1
S PXCECODE=((PXCEHLST="POV")!(PXCEHLST="CPT"))
W !
S PXCEINDX=0
F S PXCEINDX=$O(PXCEHLST(PXCEINDX)) Q:'PXCEINDX D Q:'Y
. I $P(PXCEHLST(PXCEINDX),"^",1)="" W !,?5,$P(PXCEHLST(PXCEINDX),"^",2)
. E I PXCECODE W !,$P(PXCEHLST(PXCEINDX),"^",1),?10,$P(PXCEHLST(PXCEINDX),"^",2)
. E W !,?10,$P(PXCEHLST(PXCEINDX),"^",2)
. I '(PXCEINDX#(IOSL-5)) D PAUSE
I Y,(PXCEINDX#(IOSL-5)) D PAUSE
W !
Q
;
INTRFACE(PXCEHLOC,PXCECATS,PXCELIST) ;
;Calls the AICS routine to get the selection list for one
; package interface file.
K @PXCELIST
N PXCEINTF
S PXCEINTF=$P($T(INTRFACE^@("PXCE"_PXCECATS)),";;",2)
Q:PXCEINTF=""
D GETLST^IBDF18A(PXCEHLOC,PXCEINTF,PXCELIST)
Q:'$G(@PXCELIST@(0))
S @PXCELIST=PXCECATS
Q
;
NEWENC ;Displays warning before adding a new historical encounter.
W !!,"This will create a historical encounter for documenting a clinical encounter"
W !,"only and will not be used by Scheduling, Billing or Workload credit."
D PAUSE
Q
;
PAUSE ;
N DIR
W !
S DIR(0)="E"
D ^DIR
W !
Q
;
WAIT ;
N DIR
W !
S DIR("A")="Enter RETURN to continue "
S DIR(0)="EA"
D ^DIR
W !
Q
;
;from TIUHELP ;ISL/JER - On-line help library ;
;;pre1.0;Text Integration Utilities;;Jul 24, 1995
PROTOCOL ; Help for protocols
N DIRUT,DTOUT,DUOUT,TIUX,ORU,ORUPRMT,VALMDDF,VALMPGE S TIUX=X
D FULL^VALM1
I TIUX="?" D G PROTX
. D DISP^XQORM1 W !!,"Enter selection by typing the name, or abbreviation.",!,"Enter '??' for additional details.",!
. I TIUX="?" W:$$STOP ""
I TIUX="??" D MENU(XQORNOD) I $D(DIROUT) S (XQORQUIT,XQORPOP)=1 Q
PROTX S VALMBCK="R"
Q
N TIUSEQ,TIUI,TIUJ D CLEAR^VALM1
W:$$CONTINUE "Valid selections are:",!
S TIUI=0 F S TIUI=$O(^ORD(101,+XQORNOD,10,TIUI)) Q:+TIUI'>0 D
. S TIUJ=+$P($G(^ORD(101,+XQORNOD,10,TIUI,0)),U,3) S:$D(TIUSEQ(TIUJ)) TIUJ=TIUJ+.1
. S TIUSEQ(TIUJ)=+$P(^ORD(101,+XQORNOD,10,TIUI,0),U)
S TIUI=0 F S TIUI=$O(TIUSEQ(TIUI)) Q:+TIUI'>0!$D(DIRUT) D
. I $D(^ORD(101,+TIUSEQ(TIUI),0)) D ITEM(+TIUSEQ(TIUI),1)
Q
ITEM(XQORNOD,TAB) ; Show descriptions of items
N TIUI
Q:$P($G(^ORD(101,+XQORNOD,0)),U,2)']""
W:$$CONTINUE ?+$G(TAB),$G(IOINHI),$$UPPER($P($G(^ORD(101,+XQORNOD,0)),U,2)),$G(IOINORM),!
I $D(DIRUT) Q
S TIUI=0 F S TIUI=$O(^ORD(101,+XQORNOD,1,TIUI)) Q:+TIUI'>0!$D(DIRUT) D
. W:$$CONTINUE ?(TAB+2),$G(^ORD(101,+XQORNOD,1,TIUI,0)),! Q:$D(DIRUT)
;S TIUI=0 F S TIUI=$O(^ORD(101,+XQORNOD,10,TIUI)) Q:+TIUI'>0 D
;. D ITEM(+$G(^ORD(101,+XQORNOD,10,+TIUI,0))_";ORD(101,",3)
Q
;
CONTINUE() ; Pagination control
N Y
I $Y<(IOSL-2) S Y=1 G CONTX
S Y=$$STOP("",1) W:+Y @IOF,!
CONTX Q Y
;
STOP(PROMPT,SCROLL) ; Call DIR at bottom of screen
N DIR,DA,X,Y
I $E(IOST)'="C" S Y="" G STOPX
I +$G(SCROLL),(IOSL>($Y+5)) F W ! Q:IOSL<($Y+6)
S DIR(0)="FO^1:1",DIR("A")=$S($G(PROMPT)]"":PROMPT,1:"Press RETURN to continue or '^' to exit")
S DIR("?")="Enter '^' to quit present action or '^^' to quit to menu"
D ^DIR I $D(DIRUT),(Y="") K DIRUT
S Y=$S(Y="^":0,Y="^^":0,$D(DTOUT):"",Y="":1,1:1_U_Y)
STOPX Q Y
;
UPPER(X) ; Convert lower case X to UPPER CASE
Q $TR(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
;
PXCEHELP ;ISL/dee - Used for help on input ;9/24/96
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**5**;Aug 12, 1996
+2 ;;
+3 QUIT
+4 ;
HELP ;
+1 IF $GET(PXCEHLST)'=PXCECATS
DO INTRFACE(PXCEHLOC,PXCECATS,"PXCEHLST")
+2 IF $GET(PXCEHLST)'=PXCECATS
QUIT
+3 NEW PXCEINDX,PXCECODE,Y
+4 SET Y=1
+5 SET PXCECODE=((PXCEHLST="POV")!(PXCEHLST="CPT"))
+6 WRITE !
+7 SET PXCEINDX=0
+8 FOR
SET PXCEINDX=$ORDER(PXCEHLST(PXCEINDX))
IF 'PXCEINDX
QUIT
Begin DoDot:1
+9 IF $PIECE(PXCEHLST(PXCEINDX),"^",1)=""
WRITE !,?5,$PIECE(PXCEHLST(PXCEINDX),"^",2)
+10 IF '$TEST
IF PXCECODE
WRITE !,$PIECE(PXCEHLST(PXCEINDX),"^",1),?10,$PIECE(PXCEHLST(PXCEINDX),"^",2)
+11 IF '$TEST
WRITE !,?10,$PIECE(PXCEHLST(PXCEINDX),"^",2)
+12 IF '(PXCEINDX#(IOSL-5))
DO PAUSE
End DoDot:1
IF 'Y
QUIT
+13 IF Y
IF (PXCEINDX#(IOSL-5))
DO PAUSE
+14 WRITE !
+15 QUIT
+16 ;
INTRFACE(PXCEHLOC,PXCECATS,PXCELIST) ;
+1 ;Calls the AICS routine to get the selection list for one
+2 ; package interface file.
+3 KILL @PXCELIST
+4 NEW PXCEINTF
+5 SET PXCEINTF=$PIECE($TEXT(INTRFACE^@("PXCE"_PXCECATS)),";;",2)
+6 IF PXCEINTF=""
QUIT
+7 DO GETLST^IBDF18A(PXCEHLOC,PXCEINTF,PXCELIST)
+8 IF '$GET(@PXCELIST@(0))
QUIT
+9 SET @PXCELIST=PXCECATS
+10 QUIT
+11 ;
NEWENC ;Displays warning before adding a new historical encounter.
+1 WRITE !!,"This will create a historical encounter for documenting a clinical encounter"
+2 WRITE !,"only and will not be used by Scheduling, Billing or Workload credit."
+3 DO PAUSE
+4 QUIT
+5 ;
PAUSE ;
+1 NEW DIR
+2 WRITE !
+3 SET DIR(0)="E"
+4 DO ^DIR
+5 WRITE !
+6 QUIT
+7 ;
WAIT ;
+1 NEW DIR
+2 WRITE !
+3 SET DIR("A")="Enter RETURN to continue "
+4 SET DIR(0)="EA"
+5 DO ^DIR
+6 WRITE !
+7 QUIT
+8 ;
+9 ;from TIUHELP ;ISL/JER - On-line help library ;
+10 ;;pre1.0;Text Integration Utilities;;Jul 24, 1995
PROTOCOL ; Help for protocols
+1 NEW DIRUT,DTOUT,DUOUT,TIUX,ORU,ORUPRMT,VALMDDF,VALMPGE
SET TIUX=X
+2 DO FULL^VALM1
+3 IF TIUX="?"
Begin DoDot:1
+4 DO DISP^XQORM1
WRITE !!,"Enter selection by typing the name, or abbreviation.",!,"Enter '??' for additional details.",!
+5 IF TIUX="?"
IF $$STOP
WRITE ""
End DoDot:1
GOTO PROTX
+6 IF TIUX="??"
DO MENU(XQORNOD)
IF $DATA(DIROUT)
SET (XQORQUIT,XQORPOP)=1
QUIT
PROTX SET VALMBCK="R"
+1 QUIT
+1 NEW TIUSEQ,TIUI,TIUJ
DO CLEAR^VALM1
+2 IF $$CONTINUE
WRITE "Valid selections are:",!
+3 SET TIUI=0
FOR
SET TIUI=$ORDER(^ORD(101,+XQORNOD,10,TIUI))
IF +TIUI'>0
QUIT
Begin DoDot:1
+4 SET TIUJ=+$PIECE($GET(^ORD(101,+XQORNOD,10,TIUI,0)),U,3)
IF $DATA(TIUSEQ(TIUJ))
SET TIUJ=TIUJ+.1
+5 SET TIUSEQ(TIUJ)=+$PIECE(^ORD(101,+XQORNOD,10,TIUI,0),U)
End DoDot:1
+6 SET TIUI=0
FOR
SET TIUI=$ORDER(TIUSEQ(TIUI))
IF +TIUI'>0!$DATA(DIRUT)
QUIT
Begin DoDot:1
+7 IF $DATA(^ORD(101,+TIUSEQ(TIUI),0))
DO ITEM(+TIUSEQ(TIUI),1)
End DoDot:1
+8 QUIT
ITEM(XQORNOD,TAB) ; Show descriptions of items
+1 NEW TIUI
+2 IF $PIECE($GET(^ORD(101,+XQORNOD,0)),U,2)']""
QUIT
+3 IF $$CONTINUE
WRITE ?+$GET(TAB),$GET(IOINHI),$$UPPER($PIECE($GET(^ORD(101,+XQORNOD,0)),U,2)),$GET(IOINORM),!
+4 IF $DATA(DIRUT)
QUIT
+5 SET TIUI=0
FOR
SET TIUI=$ORDER(^ORD(101,+XQORNOD,1,TIUI))
IF +TIUI'>0!$DATA(DIRUT)
QUIT
Begin DoDot:1
+6 IF $$CONTINUE
WRITE ?(TAB+2),$GET(^ORD(101,+XQORNOD,1,TIUI,0)),!
IF $DATA(DIRUT)
QUIT
End DoDot:1
+7 ;S TIUI=0 F S TIUI=$O(^ORD(101,+XQORNOD,10,TIUI)) Q:+TIUI'>0 D
+8 ;. D ITEM(+$G(^ORD(101,+XQORNOD,10,+TIUI,0))_";ORD(101,",3)
+9 QUIT
+10 ;
CONTINUE() ; Pagination control
+1 NEW Y
+2 IF $Y<(IOSL-2)
SET Y=1
GOTO CONTX
+3 SET Y=$$STOP("",1)
IF +Y
WRITE @IOF,!
CONTX QUIT Y
+1 ;
STOP(PROMPT,SCROLL) ; Call DIR at bottom of screen
+1 NEW DIR,DA,X,Y
+2 IF $EXTRACT(IOST)'="C"
SET Y=""
GOTO STOPX
+3 IF +$GET(SCROLL)
IF (IOSL>($Y+5))
FOR
WRITE !
IF IOSL<($Y+6)
QUIT
+4 SET DIR(0)="FO^1:1"
SET DIR("A")=$SELECT($GET(PROMPT)]"":PROMPT,1:"Press RETURN to continue or '^' to exit")
+5 SET DIR("?")="Enter '^' to quit present action or '^^' to quit to menu"
+6 DO ^DIR
IF $DATA(DIRUT)
IF (Y="")
KILL DIRUT
+7 SET Y=$SELECT(Y="^":0,Y="^^":0,$DATA(DTOUT):"",Y="":1,1:1_U_Y)
STOPX QUIT Y
+1 ;
UPPER(X) ; Convert lower case X to UPPER CASE
+1 QUIT $TRANSLATE(X,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+2 ;
