NURCCP2 ;HIRMFO/RM-STANDARD CARE PLAN, PRINT (selection driver) ;1/23/96
;;4.0;NURSING SERVICE;;Apr 25, 1997
SELCHC ; PRINT CHOICES TO SELECT FROM
K @ANS I 'CHC W !!,"THERE ARE NO ENTRIES TO PICK FROM" Q
SELC ;
D HDR F X=1:1:CHC D:NURCEOPG<$Y EOPG Q:NURCOUT W !,$J(X,3,0),". ",$P(^TMP($J,"CPCH",X),"^",2) I $D(^TMP($J,"CPCH",X,1)) D DXPRT Q:NURCOUT
I NURCOUT S NURCOUT=NURCOUT-1 Q
SEL ; SELECT PROMPT
W !,"Enter action: " R X:DTIME S:'$T X="^^" I "^^"[X S NURCOUT=''$L(X) K:MULT&$L(X) @ANS Q
S OK=1 I MULT S NURX=X D VALSEL I 'OK,X'="??" W !?4,"ENTER SELECTIONS USING HYPHENS AND COMMAS. E.G. 1-3,6." K @ANS
I 'MULT,X'=+X!(X<1)!(X>CHC) S OK=0 I X'="??" W !?4,$C(7),"PLEASE ENTER A NUMBER IN THE RANGE 1-",CHC
I 'OK,X'="??" W !?4,"OR ENTER ^ TO EXIT, OR ?? TO RELIST THE SELECTIONS."
G:'OK SELC:X="??",SEL
I 'MULT S @ANS=^TMP($J,"CPCH",X)
E S NURX=X D SETSEL
Q
DXPRT ; PRINT DX'S UNDER PROBLEMS
F G=1:1 S H=$G(^TMP($J,"CPCH",X,G)) Q:'$L(H) D:NURCEOPG<$Y EOPG Q:NURCOUT W !?5,"- "_$P(H,"^",2)
Q
EOPG ; END OF PAGE
W !,"Enter action (<RET> to see more): " R Y:DTIME S:'$T Y="^^" I "^^"[Y S NURCOUT=$L(Y) D:'NURCOUT HDR Q
I MULT S NURX=Y D VALSEL I OK S NURX=Y D SETSEL,HDR Q
I Y="??" S X=1 D HDR Q
W !?4,"TYPE <RET> TO CONTINUE LISTING, ?? TO RELIST THE SELECTIONS,",!?4,"^ TO STOP LISTING, ^^ TO EXIT PROGRAM" W:MULT ",",!?4,"OR MAKE SELECTIONS, CHOOSE FROM 1-",CHC W "."
G EOPG
;
HDR ; PRINT HDR & FF
W @IOF,TXT
Q
VALSEL ; VALIDATE INPUT IN NURX IN FORM 1-3,4 WITH 1-CHC AS RANGE
; SETS OK=1 IF VALID, ELSE SETS OK=0
S C=1 F A=1:1 S B=$P(NURX,",",A) Q:B="" S D=+B,E=$S(B["-":$P(B,"-",2,$L(B,"-")),1:+B) I D'=+D!(E'=+E)!(D<1)!(D>CHC)!(E<1)!(E>CHC)!(D>E) S C=0 Q
S OK=C
Q
SETSEL ; SET SELECTION ARRAY
F A=1:1 S B=$P(NURX,",",A) Q:B="" S C=+B,D=$S(B["-":$P(B,"-",2),1:+B) F E=C:1:D S F=$G(^TMP($J,"CPCH",E)),@(ANS_"(+F)")=F F Y=1:1 S Z=$G(^TMP($J,"CPCH",E,Y)) Q:Z="" S @(ANS_"(+F,+Z)")=""
Q
NURCCP2 ;HIRMFO/RM-STANDARD CARE PLAN, PRINT (selection driver) ;1/23/96
+1 ;;4.0;NURSING SERVICE;;Apr 25, 1997
SELCHC ; PRINT CHOICES TO SELECT FROM
+1 KILL @ANS
IF 'CHC
WRITE !!,"THERE ARE NO ENTRIES TO PICK FROM"
QUIT
SELC ;
+1 DO HDR
FOR X=1:1:CHC
IF NURCEOPG<$Y
DO EOPG
IF NURCOUT
QUIT
WRITE !,$JUSTIFY(X,3,0),". ",$PIECE(^TMP($JOB,"CPCH",X),"^",2)
IF $DATA(^TMP($JOB,"CPCH",X,1))
DO DXPRT
IF NURCOUT
QUIT
+2 IF NURCOUT
SET NURCOUT=NURCOUT-1
QUIT
SEL ; SELECT PROMPT
+1 WRITE !,"Enter action: "
READ X:DTIME
IF '$TEST
SET X="^^"
IF "^^"[X
SET NURCOUT=''$LENGTH(X)
IF MULT&$LENGTH(X)
KILL @ANS
QUIT
+2 SET OK=1
IF MULT
SET NURX=X
DO VALSEL
IF 'OK
IF X'="??"
WRITE !?4,"ENTER SELECTIONS USING HYPHENS AND COMMAS. E.G. 1-3,6."
KILL @ANS
+3 IF 'MULT
IF X'=+X!(X<1)!(X>CHC)
SET OK=0
IF X'="??"
WRITE !?4,$CHAR(7),"PLEASE ENTER A NUMBER IN THE RANGE 1-",CHC
+4 IF 'OK
IF X'="??"
WRITE !?4,"OR ENTER ^ TO EXIT, OR ?? TO RELIST THE SELECTIONS."
+5 IF 'OK
IF X="??"
GOTO SELC
GOTO SEL
+6 IF 'MULT
SET @ANS=^TMP($JOB,"CPCH",X)
+7 IF '$TEST
SET NURX=X
DO SETSEL
+8 QUIT
DXPRT ; PRINT DX'S UNDER PROBLEMS
+1 FOR G=1:1
SET H=$GET(^TMP($JOB,"CPCH",X,G))
IF '$LENGTH(H)
QUIT
IF NURCEOPG<$Y
DO EOPG
IF NURCOUT
QUIT
WRITE !?5,"- "_$PIECE(H,"^",2)
+2 QUIT
EOPG ; END OF PAGE
+1 WRITE !,"Enter action (<RET> to see more): "
READ Y:DTIME
IF '$TEST
SET Y="^^"
IF "^^"[Y
SET NURCOUT=$LENGTH(Y)
IF 'NURCOUT
DO HDR
QUIT
+2 IF MULT
SET NURX=Y
DO VALSEL
IF OK
SET NURX=Y
DO SETSEL
DO HDR
QUIT
+3 IF Y="??"
SET X=1
DO HDR
QUIT
+4 WRITE !?4,"TYPE <RET> TO CONTINUE LISTING, ?? TO RELIST THE SELECTIONS,",!?4,"^ TO STOP LISTING, ^^ TO EXIT PROGRAM"
IF MULT
WRITE ",",!?4,"OR MAKE SELECTIONS, CHOOSE FROM 1-",CHC
WRITE "."
+5 GOTO EOPG
+6 ;
HDR ; PRINT HDR & FF
+1 WRITE @IOF,TXT
+2 QUIT
VALSEL ; VALIDATE INPUT IN NURX IN FORM 1-3,4 WITH 1-CHC AS RANGE
+1 ; SETS OK=1 IF VALID, ELSE SETS OK=0
+2 SET C=1
FOR A=1:1
SET B=$PIECE(NURX,",",A)
IF B=""
QUIT
SET D=+B
SET E=$SELECT(B["-":$PIECE(B,"-",2,$LENGTH(B,"-")),1:+B)
IF D'=+D!(E'=+E)!(D<1)!(D>CHC)!(E<1)!(E>CHC)!(D>E)
SET C=0
QUIT
+3 SET OK=C
+4 QUIT
SETSEL ; SET SELECTION ARRAY
+1 FOR A=1:1
SET B=$PIECE(NURX,",",A)
IF B=""
QUIT
SET C=+B
SET D=$SELECT(B["-":$PIECE(B,"-",2),1:+B)
FOR E=C:1:D
SET F=$GET(^TMP($JOB,"CPCH",E))
SET @(ANS_"(+F)")=F
FOR Y=1:1
SET Z=$GET(^TMP($JOB,"CPCH",E,Y))
IF Z=""
QUIT
SET @(ANS_"(+F,+Z)")=""
+2 QUIT
