Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXBGSTP2

PXBGSTP2.m

Go to the documentation of this file.
  1. PXBGSTP2 ;ISL/JVS - DOUBLE ?? GATHERING OF STOP CODES ;1/24/97 14:14
  1. ;;1.0;PCE PATIENT CARE ENCOUNTER;**11,19**;Aug 12, 1996
  1. ;
  1. ;
  1. ;
  1. W !,"NOT" Q
  1. ;
  1. DOUBLE(FROM) ;--Entry point
  1. ;
  1. N FILE,FIELD,TITLE,HEADING,SUB,CODE,NAME,START,SCREEN,BACK,NUM
  1. N SCREEN,TEMP,NRD,SUB2
  1. S BACK="",NUM=0,SCREEN=""
  1. D LOC
  1. I $D(DIC("S")) S SCREEN=DIC("S")
  1. ;
  1. START ;--RECYCLE
  1. ;
  1. S TITLE="- - A L L S T O P C O D E S - -"
  1. ;
  1. D SETUP
  1. D LIST^DIC(FILE,"",FIELD,BACK,10,.START,"","C",SCREEN,"","^TMP(""PXBTANA"",$J)","^TMP(""PXBTANA"",$J)")
  1. ;
  1. D LOC,HEAD,SUB
  1. ;
  1. PROMPT ;--PROMPT
  1. D WIN17^PXBCC(PXBCNT),LOC^PXBCC(15,1)
  1. W !!,"Enter '^' to quit, '-' for previous page."
  1. S DIR("A")="Select a single 'ITEM NUMBER' or 'RETURN' to continue: "
  1. S DIR("?")="Enter ITEM 'No' to select , '^' to quit, '-' for previous page."
  1. S DIR(0)="N,A,O^0:10:0^I X'?.1""-"".1""^"".2N!(+X>10) K X"
  1. D ^DIR
  1. I X="-" S BACK="B" D BACK G START
  1. I X="" S BACK="" D FORWARD G START
  1. I $G(DIRUT) K DIRUT S VAL="^S" G EXIT
  1. FINISH ;--FINISH
  1. ;
  1. S VAL=$G(^TMP("PXBTANA",$J,"DILIST",2,X))_"^"_$G(^TMP("PXBTANA",$J,"DILIST","ID",X,FIRST))_"--"_$G(^TMP("PXBTANA",$J,"DILIST","ID",X,SECOND))
  1. EXIT ;--EXIT
  1. K DIR,^TMP("PXBTANA",$J),^TMP("PXBTOTAL",$J)
  1. Q VAL
  1. ;
  1. DOUBLE1(FROM) ;--Entry point
  1. ;
  1. N FILE,FIELD,TITLE,HEADING,SUB,CODE,NAME,START,SCREEN,CNT,OK,INDEX,CYCLE
  1. N TOTAL,TEMP,SUB2
  1. ;---SETUP VARIABLES
  1. S BACK="",INDEX=""
  1. S START=DATA,SUB=0,SUB2=0
  1. ;
  1. START1 ;--RECYCLE POINT
  1. S TITLE="- - S E L E C T E D S T O P C O D E S - -"
  1. S FILE=40.7
  1. S FIELD="1;.01"
  1. I DATA?1N S START=DATA*100,INDEX="C"
  1. I DATA?2N S START=DATA*10,INDEX="C"
  1. I DATA?3N S START=(DATA-(1)),INDEX="C"
  1. I DATA?2.A S START=$O(^DIC(40.7,"B",DATA),-1)
  1. I DATA?1A S DATA="*"
  1. ;
  1. D LIST^DIC(FILE,"",FIELD,BACK,"",.START,DATA,INDEX,DIC("S"),"","^TMP(""PXBTOTAL"",$J)","^TMP(""PXBTOTAL"",$J)")
  1. ;
  1. S TOTAL=$P(^TMP("PXBTOTAL",$J,"DILIST",0),"^",1)
  1. ;
  1. ;--DISPLAY IF NO MATCH FOUND
  1. I TOTAL=0 D
  1. .I DATA="*" W ! D HELP^PXBUTL0("CPT4")
  1. .I DATA'="*" W ! D HELP^PXBUTL0("CPTM")
  1. .S ERROR=1,CYCL=1
  1. I TOTAL=0 Q TOTAL
  1. ;
  1. ;
  1. ;----DISPLAY LIST TO THE SCREEN
  1. S HEADING="W !,""ITEM"",?6,""CODE"",?15,""DESCRIPTION "",IOINHI,TOTAL,"" MATCHES"",IOINLOW"
  1. LIST ;-DISPLAY LIST TO THE SCREEN
  1. I TOTAL=1 S X=1 G VAL
  1. D LOC W !
  1. X HEADING
  1. S SUB=SUB-1
  1. S NUM=0 F S SUB=$O(^TMP("PXBTOTAL",$J,"DILIST","ID",SUB)) S NUM=NUM+1 Q:NUM=11 Q:SUB'>0 S SUB2=SUB2+1 D
  1. .S CODE=$G(^TMP("PXBTOTAL",$J,"DILIST","ID",SUB,1))
  1. .S NAME=$G(^TMP("PXBTOTAL",$J,"DILIST","ID",SUB,.01))
  1. .W !,SUB,?6,CODE,?15,NAME
  1. ;
  1. ;----If There is only one selection go to proper prompting
  1. I TOTAL=1 G PRMPT2
  1. ;
  1. PRMPT ;---WRITE PROMPT HERE
  1. D WIN17^PXBCC(PXBCNT)
  1. D LOC^PXBCC(15,1)
  1. W !
  1. I SUB>0 W !,"Enter '^' to quit"
  1. E I TOTAL>10 W !," END OF LIST"
  1. I SUB>0 S DIR("A")="Select a single 'ITEM NUMBER' or 'RETURN' to continue: "
  1. E S DIR("A")="Select a single 'ITEM NUMBER' or 'RETURN' to exit: "
  1. S DIR("?")="Enter ITEM 'No' to select , '^' to quit"
  1. S DIR(0)="N,A,O^0:"_SUB2_":0^I X'?.1""^"".N K X"
  1. D ^DIR
  1. I X="",SUB>0 G LIST
  1. I X="",SUB'>0 S X="^"
  1. VAL ;-----Set the VAL equal to the value
  1. S VAL=$G(^TMP("PXBTOTAL",$J,"DILIST",2,X))_"^"_$G(^TMP("PXBTOTAL",$J,"DILIST","ID",X,1))_"--"_$G(^TMP("PXBTOTAL",$J,"DILIST","ID",X,.01))
  1. EXITNEW ;--EXIT
  1. K DIR,^TMP("PXBTANA",$J),^TMP("PXBTOTAL",$J)
  1. K TANA,TOTAL
  1. Q VAL
  1. Q
  1. ;
  1. ;-----------------SUBROUTINES--------------
  1. BACK ;
  1. S START=$G(^TMP("PXBTANA",$J,"DILIST",1,1))
  1. S START("IEN")=$G(^TMP("PXBTANA",$J,"DILIST",2,1))
  1. Q
  1. FORWARD ;
  1. S START=$G(^TMP("PXBTANA",$J,"DILIST",1,10))
  1. S START("IEN")=$G(^TMP("PXBTANA",$J,"DILIST",2,10))
  1. Q
  1. LOC ;--LOCATE CURSOR
  1. D LOC^PXBCC(3,1) ;--LOCATE THE CURSOR
  1. W IOEDEOP ;--CLEAR THE PAGE
  1. Q
  1. W !,IOCUU,IOBON,"HELP SCREEN",IOSGR0,?(IOM-$L(TITLE))\2,IOINHI,TITLE,IOINLOW,IOELEOL
  1. Q
  1. SUB ;--DISPLAY LIST TO THE SCREEN
  1. I $P(^TMP("PXBTANA",$J,"DILIST",0),"^",1)=0 W !!," E N D O F L I S T" Q
  1. X HEADING
  1. S SUB=0,CNT=0 F S SUB=$O(^TMP("PXBTANA",$J,"DILIST","ID",SUB)) Q:SUB'>0 S CNT=CNT+1 D
  1. .S CODE=$G(^TMP("PXBTANA",$J,"DILIST","ID",SUB,FIRST))
  1. .S NAME=$G(^TMP("PXBTANA",$J,"DILIST","ID",SUB,SECOND))
  1. .W !,SUB,?6,CODE,?15,NAME
  1. Q
  1. SETUP ;-SETP VARIABLES
  1. S FILE=40.7,FIRST=1,SECOND=.01 D
  1. S FIELD=FIRST_";"_SECOND
  1. S HEADING="W !,""ITEM"",?6,""CODE"",?15,""DESCRIPTION"""
  1. Q
  1. PRMPT2 ;-----Yes and No prompt if onlyi choice
  1. D WIN17^PXBCC(PXBCNT)
  1. D LOC^PXBCC(15,1)
  1. S DIR("A")="Is this the correct entry "
  1. S DIR("B")="YES"
  1. S DIR(0)="Y"
  1. D ^DIR
  1. I Y=0 S X="^"
  1. I Y=1 S X=1
  1. G VAL