- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURCCP2 1962 printed Jan 18, 2025@03:21:21 Page 2
- 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