- PXBGSTP2 ;ISL/JVS - DOUBLE ?? GATHERING OF STOP CODES ;1/24/97 14:14
- ;;1.0;PCE PATIENT CARE ENCOUNTER;**11,19**;Aug 12, 1996
- ;
- ;
- ;
- W !,"NOT" Q
- ;
- DOUBLE(FROM) ;--Entry point
- ;
- N FILE,FIELD,TITLE,HEADING,SUB,CODE,NAME,START,SCREEN,BACK,NUM
- N SCREEN,TEMP,NRD,SUB2
- S BACK="",NUM=0,SCREEN=""
- D LOC
- I $D(DIC("S")) S SCREEN=DIC("S")
- ;
- START ;--RECYCLE
- ;
- S TITLE="- - A L L S T O P C O D E S - -"
- ;
- D SETUP
- D LIST^DIC(FILE,"",FIELD,BACK,10,.START,"","C",SCREEN,"","^TMP(""PXBTANA"",$J)","^TMP(""PXBTANA"",$J)")
- ;
- D LOC,HEAD,SUB
- ;
- PROMPT ;--PROMPT
- D WIN17^PXBCC(PXBCNT),LOC^PXBCC(15,1)
- W !!,"Enter '^' to quit, '-' for previous page."
- S DIR("A")="Select a single 'ITEM NUMBER' or 'RETURN' to continue: "
- S DIR("?")="Enter ITEM 'No' to select , '^' to quit, '-' for previous page."
- S DIR(0)="N,A,O^0:10:0^I X'?.1""-"".1""^"".2N!(+X>10) K X"
- D ^DIR
- I X="-" S BACK="B" D BACK G START
- I X="" S BACK="" D FORWARD G START
- I $G(DIRUT) K DIRUT S VAL="^S" G EXIT
- FINISH ;--FINISH
- ;
- 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))
- EXIT ;--EXIT
- K DIR,^TMP("PXBTANA",$J),^TMP("PXBTOTAL",$J)
- Q VAL
- ;
- DOUBLE1(FROM) ;--Entry point
- ;
- N FILE,FIELD,TITLE,HEADING,SUB,CODE,NAME,START,SCREEN,CNT,OK,INDEX,CYCLE
- N TOTAL,TEMP,SUB2
- ;---SETUP VARIABLES
- S BACK="",INDEX=""
- S START=DATA,SUB=0,SUB2=0
- ;
- START1 ;--RECYCLE POINT
- S TITLE="- - S E L E C T E D S T O P C O D E S - -"
- S FILE=40.7
- S FIELD="1;.01"
- I DATA?1N S START=DATA*100,INDEX="C"
- I DATA?2N S START=DATA*10,INDEX="C"
- I DATA?3N S START=(DATA-(1)),INDEX="C"
- I DATA?2.A S START=$O(^DIC(40.7,"B",DATA),-1)
- I DATA?1A S DATA="*"
- ;
- D LIST^DIC(FILE,"",FIELD,BACK,"",.START,DATA,INDEX,DIC("S"),"","^TMP(""PXBTOTAL"",$J)","^TMP(""PXBTOTAL"",$J)")
- ;
- S TOTAL=$P(^TMP("PXBTOTAL",$J,"DILIST",0),"^",1)
- ;
- ;--DISPLAY IF NO MATCH FOUND
- I TOTAL=0 D
- .I DATA="*" W ! D HELP^PXBUTL0("CPT4")
- .I DATA'="*" W ! D HELP^PXBUTL0("CPTM")
- .S ERROR=1,CYCL=1
- I TOTAL=0 Q TOTAL
- ;
- ;
- ;----DISPLAY LIST TO THE SCREEN
- S HEADING="W !,""ITEM"",?6,""CODE"",?15,""DESCRIPTION "",IOINHI,TOTAL,"" MATCHES"",IOINLOW"
- LIST ;-DISPLAY LIST TO THE SCREEN
- I TOTAL=1 S X=1 G VAL
- D LOC W !
- X HEADING
- S SUB=SUB-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
- .S CODE=$G(^TMP("PXBTOTAL",$J,"DILIST","ID",SUB,1))
- .S NAME=$G(^TMP("PXBTOTAL",$J,"DILIST","ID",SUB,.01))
- .W !,SUB,?6,CODE,?15,NAME
- ;
- ;----If There is only one selection go to proper prompting
- I TOTAL=1 G PRMPT2
- ;
- PRMPT ;---WRITE PROMPT HERE
- D WIN17^PXBCC(PXBCNT)
- D LOC^PXBCC(15,1)
- W !
- I SUB>0 W !,"Enter '^' to quit"
- E I TOTAL>10 W !," END OF LIST"
- I SUB>0 S DIR("A")="Select a single 'ITEM NUMBER' or 'RETURN' to continue: "
- E S DIR("A")="Select a single 'ITEM NUMBER' or 'RETURN' to exit: "
- S DIR("?")="Enter ITEM 'No' to select , '^' to quit"
- S DIR(0)="N,A,O^0:"_SUB2_":0^I X'?.1""^"".N K X"
- D ^DIR
- I X="",SUB>0 G LIST
- I X="",SUB'>0 S X="^"
- VAL ;-----Set the VAL equal to the value
- 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))
- EXITNEW ;--EXIT
- K DIR,^TMP("PXBTANA",$J),^TMP("PXBTOTAL",$J)
- K TANA,TOTAL
- Q VAL
- Q
- ;
- ;-----------------SUBROUTINES--------------
- BACK ;
- S START=$G(^TMP("PXBTANA",$J,"DILIST",1,1))
- S START("IEN")=$G(^TMP("PXBTANA",$J,"DILIST",2,1))
- Q
- FORWARD ;
- S START=$G(^TMP("PXBTANA",$J,"DILIST",1,10))
- S START("IEN")=$G(^TMP("PXBTANA",$J,"DILIST",2,10))
- Q
- LOC ;--LOCATE CURSOR
- D LOC^PXBCC(3,1) ;--LOCATE THE CURSOR
- W IOEDEOP ;--CLEAR THE PAGE
- Q
- HEAD ;--HEAD
- W !,IOCUU,IOBON,"HELP SCREEN",IOSGR0,?(IOM-$L(TITLE))\2,IOINHI,TITLE,IOINLOW,IOELEOL
- Q
- SUB ;--DISPLAY LIST TO THE SCREEN
- I $P(^TMP("PXBTANA",$J,"DILIST",0),"^",1)=0 W !!," E N D O F L I S T" Q
- X HEADING
- S SUB=0,CNT=0 F S SUB=$O(^TMP("PXBTANA",$J,"DILIST","ID",SUB)) Q:SUB'>0 S CNT=CNT+1 D
- .S CODE=$G(^TMP("PXBTANA",$J,"DILIST","ID",SUB,FIRST))
- .S NAME=$G(^TMP("PXBTANA",$J,"DILIST","ID",SUB,SECOND))
- .W !,SUB,?6,CODE,?15,NAME
- Q
- SETUP ;-SETP VARIABLES
- S FILE=40.7,FIRST=1,SECOND=.01 D
- S FIELD=FIRST_";"_SECOND
- S HEADING="W !,""ITEM"",?6,""CODE"",?15,""DESCRIPTION"""
- Q
- PRMPT2 ;-----Yes and No prompt if onlyi choice
- D WIN17^PXBCC(PXBCNT)
- D LOC^PXBCC(15,1)
- S DIR("A")="Is this the correct entry "
- S DIR("B")="YES"
- S DIR(0)="Y"
- D ^DIR
- I Y=0 S X="^"
- I Y=1 S X=1
- G VAL
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXBGSTP2 4627 printed Jan 18, 2025@03:27:50 Page 2
- 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
- +2 ;
- +3 ;
- +4 ;
- +5 WRITE !,"NOT"
- QUIT
- +6 ;
- DOUBLE(FROM) ;--Entry point
- +1 ;
- +2 NEW FILE,FIELD,TITLE,HEADING,SUB,CODE,NAME,START,SCREEN,BACK,NUM
- +3 NEW SCREEN,TEMP,NRD,SUB2
- +4 SET BACK=""
- SET NUM=0
- SET SCREEN=""
- +5 DO LOC
- +6 IF $DATA(DIC("S"))
- SET SCREEN=DIC("S")
- +7 ;
- START ;--RECYCLE
- +1 ;
- +2 SET TITLE="- - A L L S T O P C O D E S - -"
- +3 ;
- +4 DO SETUP
- +5 DO LIST^DIC(FILE,"",FIELD,BACK,10,.START,"","C",SCREEN,"","^TMP(""PXBTANA"",$J)","^TMP(""PXBTANA"",$J)")
- +6 ;
- +7 DO LOC
- DO HEAD
- DO SUB
- +8 ;
- PROMPT ;--PROMPT
- +1 DO WIN17^PXBCC(PXBCNT)
- DO LOC^PXBCC(15,1)
- +2 WRITE !!,"Enter '^' to quit, '-' for previous page."
- +3 SET DIR("A")="Select a single 'ITEM NUMBER' or 'RETURN' to continue: "
- +4 SET DIR("?")="Enter ITEM 'No' to select , '^' to quit, '-' for previous page."
- +5 SET DIR(0)="N,A,O^0:10:0^I X'?.1""-"".1""^"".2N!(+X>10) K X"
- +6 DO ^DIR
- +7 IF X="-"
- SET BACK="B"
- DO BACK
- GOTO START
- +8 IF X=""
- SET BACK=""
- DO FORWARD
- GOTO START
- +9 IF $GET(DIRUT)
- KILL DIRUT
- SET VAL="^S"
- GOTO EXIT
- FINISH ;--FINISH
- +1 ;
- +2 SET VAL=$GET(^TMP("PXBTANA",$JOB,"DILIST",2,X))_"^"_$GET(^TMP("PXBTANA",$JOB,"DILIST","ID",X,FIRST))_"--"_$GET(^TMP("PXBTANA",$JOB,"DILIST","ID",X,SECOND))
- EXIT ;--EXIT
- +1 KILL DIR,^TMP("PXBTANA",$JOB),^TMP("PXBTOTAL",$JOB)
- +2 QUIT VAL
- +3 ;
- DOUBLE1(FROM) ;--Entry point
- +1 ;
- +2 NEW FILE,FIELD,TITLE,HEADING,SUB,CODE,NAME,START,SCREEN,CNT,OK,INDEX,CYCLE
- +3 NEW TOTAL,TEMP,SUB2
- +4 ;---SETUP VARIABLES
- +5 SET BACK=""
- SET INDEX=""
- +6 SET START=DATA
- SET SUB=0
- SET SUB2=0
- +7 ;
- START1 ;--RECYCLE POINT
- +1 SET TITLE="- - S E L E C T E D S T O P C O D E S - -"
- +2 SET FILE=40.7
- +3 SET FIELD="1;.01"
- +4 IF DATA?1N
- SET START=DATA*100
- SET INDEX="C"
- +5 IF DATA?2N
- SET START=DATA*10
- SET INDEX="C"
- +6 IF DATA?3N
- SET START=(DATA-(1))
- SET INDEX="C"
- +7 IF DATA?2.A
- SET START=$ORDER(^DIC(40.7,"B",DATA),-1)
- +8 IF DATA?1A
- SET DATA="*"
- +9 ;
- +10 DO LIST^DIC(FILE,"",FIELD,BACK,"",.START,DATA,INDEX,DIC("S"),"","^TMP(""PXBTOTAL"",$J)","^TMP(""PXBTOTAL"",$J)")
- +11 ;
- +12 SET TOTAL=$PIECE(^TMP("PXBTOTAL",$JOB,"DILIST",0),"^",1)
- +13 ;
- +14 ;--DISPLAY IF NO MATCH FOUND
- +15 IF TOTAL=0
- Begin DoDot:1
- +16 IF DATA="*"
- WRITE !
- DO HELP^PXBUTL0("CPT4")
- +17 IF DATA'="*"
- WRITE !
- DO HELP^PXBUTL0("CPTM")
- +18 SET ERROR=1
- SET CYCL=1
- End DoDot:1
- +19 IF TOTAL=0
- QUIT TOTAL
- +20 ;
- +21 ;
- +22 ;----DISPLAY LIST TO THE SCREEN
- +23 SET HEADING="W !,""ITEM"",?6,""CODE"",?15,""DESCRIPTION "",IOINHI,TOTAL,"" MATCHES"",IOINLOW"
- LIST ;-DISPLAY LIST TO THE SCREEN
- +1 IF TOTAL=1
- SET X=1
- GOTO VAL
- +2 DO LOC
- WRITE !
- +3 XECUTE HEADING
- +4 SET SUB=SUB-1
- +5 SET NUM=0
- FOR
- SET SUB=$ORDER(^TMP("PXBTOTAL",$JOB,"DILIST","ID",SUB))
- SET NUM=NUM+1
- if NUM=11
- QUIT
- if SUB'>0
- QUIT
- SET SUB2=SUB2+1
- Begin DoDot:1
- +6 SET CODE=$GET(^TMP("PXBTOTAL",$JOB,"DILIST","ID",SUB,1))
- +7 SET NAME=$GET(^TMP("PXBTOTAL",$JOB,"DILIST","ID",SUB,.01))
- +8 WRITE !,SUB,?6,CODE,?15,NAME
- End DoDot:1
- +9 ;
- +10 ;----If There is only one selection go to proper prompting
- +11 IF TOTAL=1
- GOTO PRMPT2
- +12 ;
- PRMPT ;---WRITE PROMPT HERE
- +1 DO WIN17^PXBCC(PXBCNT)
- +2 DO LOC^PXBCC(15,1)
- +3 WRITE !
- +4 IF SUB>0
- WRITE !,"Enter '^' to quit"
- +5 IF '$TEST
- IF TOTAL>10
- WRITE !," END OF LIST"
- +6 IF SUB>0
- SET DIR("A")="Select a single 'ITEM NUMBER' or 'RETURN' to continue: "
- +7 IF '$TEST
- SET DIR("A")="Select a single 'ITEM NUMBER' or 'RETURN' to exit: "
- +8 SET DIR("?")="Enter ITEM 'No' to select , '^' to quit"
- +9 SET DIR(0)="N,A,O^0:"_SUB2_":0^I X'?.1""^"".N K X"
- +10 DO ^DIR
- +11 IF X=""
- IF SUB>0
- GOTO LIST
- +12 IF X=""
- IF SUB'>0
- SET X="^"
- VAL ;-----Set the VAL equal to the value
- +1 SET VAL=$GET(^TMP("PXBTOTAL",$JOB,"DILIST",2,X))_"^"_$GET(^TMP("PXBTOTAL",$JOB,"DILIST","ID",X,1))_"--"_$GET(^TMP("PXBTOTAL",$JOB,"DILIST","ID",X,.01))
- EXITNEW ;--EXIT
- +1 KILL DIR,^TMP("PXBTANA",$JOB),^TMP("PXBTOTAL",$JOB)
- +2 KILL TANA,TOTAL
- +3 QUIT VAL
- +4 QUIT
- +5 ;
- +6 ;-----------------SUBROUTINES--------------
- BACK ;
- +1 SET START=$GET(^TMP("PXBTANA",$JOB,"DILIST",1,1))
- +2 SET START("IEN")=$GET(^TMP("PXBTANA",$JOB,"DILIST",2,1))
- +3 QUIT
- FORWARD ;
- +1 SET START=$GET(^TMP("PXBTANA",$JOB,"DILIST",1,10))
- +2 SET START("IEN")=$GET(^TMP("PXBTANA",$JOB,"DILIST",2,10))
- +3 QUIT
- LOC ;--LOCATE CURSOR
- +1 ;--LOCATE THE CURSOR
- DO LOC^PXBCC(3,1)
- +2 ;--CLEAR THE PAGE
- WRITE IOEDEOP
- +3 QUIT
- HEAD ;--HEAD
- +1 WRITE !,IOCUU,IOBON,"HELP SCREEN",IOSGR0,?(IOM-$LENGTH(TITLE))\2,IOINHI,TITLE,IOINLOW,IOELEOL
- +2 QUIT
- SUB ;--DISPLAY LIST TO THE SCREEN
- +1 IF $PIECE(^TMP("PXBTANA",$JOB,"DILIST",0),"^",1)=0
- WRITE !!," E N D O F L I S T"
- QUIT
- +2 XECUTE HEADING
- +3 SET SUB=0
- SET CNT=0
- FOR
- SET SUB=$ORDER(^TMP("PXBTANA",$JOB,"DILIST","ID",SUB))
- if SUB'>0
- QUIT
- SET CNT=CNT+1
- Begin DoDot:1
- +4 SET CODE=$GET(^TMP("PXBTANA",$JOB,"DILIST","ID",SUB,FIRST))
- +5 SET NAME=$GET(^TMP("PXBTANA",$JOB,"DILIST","ID",SUB,SECOND))
- +6 WRITE !,SUB,?6,CODE,?15,NAME
- End DoDot:1
- +7 QUIT
- SETUP ;-SETP VARIABLES
- +1 SET FILE=40.7
- SET FIRST=1
- SET SECOND=.01
- Begin DoDot:1
- End DoDot:1
- +2 SET FIELD=FIRST_";"_SECOND
- +3 SET HEADING="W !,""ITEM"",?6,""CODE"",?15,""DESCRIPTION"""
- +4 QUIT
- PRMPT2 ;-----Yes and No prompt if onlyi choice
- +1 DO WIN17^PXBCC(PXBCNT)
- +2 DO LOC^PXBCC(15,1)
- +3 SET DIR("A")="Is this the correct entry "
- +4 SET DIR("B")="YES"
- +5 SET DIR(0)="Y"
- +6 DO ^DIR
- +7 IF Y=0
- SET X="^"
- +8 IF Y=1
- SET X=1
- +9 GOTO VAL