- PXCEHELP ;ISL/dee - Used for help on input ; 5/7/03 3:38pm
- ;;1.0;PCE PATIENT CARE ENCOUNTER;**5,121**;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,PXCEDT
- S PXCEINTF=$P($T(INTRFACE^@("PXCE"_PXCECATS)),";;",2)
- Q:PXCEINTF=""
- S PXCEDT=+^TMP("PXK",$J,"VST",1,0,"AFTER")
- D GETLST^IBDF18A(PXCEHLOC,PXCEINTF,PXCELIST,,,,PXCEDT)
- 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")
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXCEHELP 3566 printed Jan 18, 2025@03:29:02 Page 2
- PXCEHELP ;ISL/dee - Used for help on input ; 5/7/03 3:38pm
- +1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**5,121**;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,PXCEDT
- +5 SET PXCEINTF=$PIECE($TEXT(INTRFACE^@("PXCE"_PXCECATS)),";;",2)
- +6 if PXCEINTF=""
- QUIT
- +7 SET PXCEDT=+^TMP("PXK",$JOB,"VST",1,0,"AFTER")
- +8 DO GETLST^IBDF18A(PXCEHLOC,PXCEINTF,PXCELIST,,,,PXCEDT)
- +9 if '$GET(@PXCELIST@(0))
- QUIT
- +10 SET @PXCELIST=PXCECATS
- +11 QUIT
- +12 ;
- 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 ;