NURCCP3 ;HIRMFO/RM-STANDARD CARE PLAN, PRINT (sort to get problems) ;3/9/92
;;4.0;NURSING SERVICE;;Apr 25, 1997
GETPROB ; GO THROUGH EACH LEVEL OF CHILDREN FOR LIST OF PARENTS IN
; NURCSECT ARRAY UNTIL ALL PROBLEMS REACHED. PROBLEMS ARE SET INTO
; ^TMP($J,"PDOC"
D WAIT^DICD,GETSEL
I CHC>0 S TXT="Would you like to list the contents of:",MULT=1,ANS="NURCSECT" D SELCHC^NURCCP2 Q:NURCOUT!'$D(NURCSECT) D GETPROB
Q
GETSEL ; RETURNS CHC=NUMBER OF CHOICES IN ^TMP($J,"CPCH"
; ARRAY THAT WERE CHILDREN OF NURCSECT.
K ^TMP($J,"CPPH"),^("CPCH") S CHC=0
F A=0:0 S A=$O(NURCSECT(A)) Q:A'>0 D HIER
S Y=0,A="" F S A=$O(^TMP($J,"CPPH",A)) Q:A="" D G5
S CHC=Y
Q
SETPROB ; CONTINUATION OF FOR LOOP TO SET PROBLEM ARRAY OR CHC ARRAY
S Y=$G(^GMRD(124.2,+X,0))
I $P(Y,"^",4)=NURCPROB S ^TMP($J,"PDOC",B,+X,A)=$P(X,"^",1,2)
E S ^TMP($J,"CPPH",B,+X)=$P(X,"^",1,2),^TMP($J,"PARN",+X,A)=$P(X,"^",1,2)
Q
HIER ; SET THE PATH DOWN TO THIS NODE FOR THE PRINT AND PROCESS THE CHILDREN
F B=0:0 S B=$O(^TMP($J,"PARN",A,B)) Q:B'>0 S ^TMP($J,"LVL",B,$P(NURCSECT(A),"^",2),A)=$G(NURCSECT(A))
S B="" F S B=$O(^GMRD(124.2,A,1,"AC",B)) Q:B="" F C=0:0 S C=$O(^GMRD(124.2,A,1,"AC",B,C)) Q:C'>0 S X=$G(^GMRD(124.2,A,1,C,0)) D SETPROB
Q
G5 ; CONTINUATION OF LINE GETSEL+5
F B=0:0 S B=$O(^TMP($J,"CPPH",A,B)) Q:B'>0 S Y=Y+1,^TMP($J,"CPCH",Y)=$G(^TMP($J,"CPPH",A,B))
Q
MEDSECT ; PICK MEDICAL SECTIONS, THEN DETERMINE IF WILL ONLY PRINT
; MEDICAL DX, MEDICAL DX/PROBLEMS ONLY, OR SELECTED MEDICAL DX/PROBLEMS
D WAIT^DICD,GETSEL
I CHC>0 S TXT="Would you like to list the contents of:",MULT=1,ANS="NURCANS" D SELCHC^NURCCP2 I NURCOUT!'$D(NURCANS) S X=$S(NURCOUT:-1,1:0) Q
K ^TMP($J,"CPCH") S ^TMP($J,"CPCH",1)="1^Medical DX only",^(2)="2^Medical DX/Problems only",^(3)="3^Selected Medical DX/Problems",CHC=3,TXT="Would you like to print:",MULT=0,ANS="NURCDAT" D SELCHC^NURCCP2
I NURCOUT!'$D(NURCDAT) S X=$S(NURCOUT:-1,1:0) Q
I +NURCDAT>0 K NURCSECT X "F X=0:0 S X=$O(NURCANS(X)) Q:X'>0 S NURCSECT(X)=NURCANS(X)" I +NURCDAT=3 S X=2 Q
D WAIT^DICD,GETSEL
K NURCSECT F X=0:0 S X=$O(^TMP($J,"CPCH",X)) Q:X'>0 S CHC=$G(^TMP($J,"CPCH",X)) I +CHC>0 S NURCSECT(+CHC)=CHC
D GETSEL K ^TMP($J,"CPCH")
I +NURCDAT=2 S X="" F S X=$O(^TMP($J,"PDOC",X)) Q:X="" F Y=0:0 S Y=$O(^TMP($J,"PDOC",X,Y)) Q:Y'>0 F Z=0:0 S Z=$O(^TMP($J,"PDOC",X,Y,Z)) Q:Z'>0 S ^TMP($J,"PROB",Z,X,Y)=$G(^TMP($J,"PDOC",X,Y,Z))
S X=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURCCP3 2437 printed Sep 15, 2024@21:44:18 Page 2
NURCCP3 ;HIRMFO/RM-STANDARD CARE PLAN, PRINT (sort to get problems) ;3/9/92
+1 ;;4.0;NURSING SERVICE;;Apr 25, 1997
GETPROB ; GO THROUGH EACH LEVEL OF CHILDREN FOR LIST OF PARENTS IN
+1 ; NURCSECT ARRAY UNTIL ALL PROBLEMS REACHED. PROBLEMS ARE SET INTO
+2 ; ^TMP($J,"PDOC"
+3 DO WAIT^DICD
DO GETSEL
+4 IF CHC>0
SET TXT="Would you like to list the contents of:"
SET MULT=1
SET ANS="NURCSECT"
DO SELCHC^NURCCP2
if NURCOUT!'$DATA(NURCSECT)
QUIT
DO GETPROB
+5 QUIT
GETSEL ; RETURNS CHC=NUMBER OF CHOICES IN ^TMP($J,"CPCH"
+1 ; ARRAY THAT WERE CHILDREN OF NURCSECT.
+2 KILL ^TMP($JOB,"CPPH"),^("CPCH")
SET CHC=0
+3 FOR A=0:0
SET A=$ORDER(NURCSECT(A))
if A'>0
QUIT
DO HIER
+4 SET Y=0
SET A=""
FOR
SET A=$ORDER(^TMP($JOB,"CPPH",A))
if A=""
QUIT
DO G5
+5 SET CHC=Y
+6 QUIT
SETPROB ; CONTINUATION OF FOR LOOP TO SET PROBLEM ARRAY OR CHC ARRAY
+1 SET Y=$GET(^GMRD(124.2,+X,0))
+2 IF $PIECE(Y,"^",4)=NURCPROB
SET ^TMP($JOB,"PDOC",B,+X,A)=$PIECE(X,"^",1,2)
+3 IF '$TEST
SET ^TMP($JOB,"CPPH",B,+X)=$PIECE(X,"^",1,2)
SET ^TMP($JOB,"PARN",+X,A)=$PIECE(X,"^",1,2)
+4 QUIT
HIER ; SET THE PATH DOWN TO THIS NODE FOR THE PRINT AND PROCESS THE CHILDREN
+1 FOR B=0:0
SET B=$ORDER(^TMP($JOB,"PARN",A,B))
if B'>0
QUIT
SET ^TMP($JOB,"LVL",B,$PIECE(NURCSECT(A),"^",2),A)=$GET(NURCSECT(A))
+2 SET B=""
FOR
SET B=$ORDER(^GMRD(124.2,A,1,"AC",B))
if B=""
QUIT
FOR C=0:0
SET C=$ORDER(^GMRD(124.2,A,1,"AC",B,C))
if C'>0
QUIT
SET X=$GET(^GMRD(124.2,A,1,C,0))
DO SETPROB
+3 QUIT
G5 ; CONTINUATION OF LINE GETSEL+5
+1 FOR B=0:0
SET B=$ORDER(^TMP($JOB,"CPPH",A,B))
if B'>0
QUIT
SET Y=Y+1
SET ^TMP($JOB,"CPCH",Y)=$GET(^TMP($JOB,"CPPH",A,B))
+2 QUIT
MEDSECT ; PICK MEDICAL SECTIONS, THEN DETERMINE IF WILL ONLY PRINT
+1 ; MEDICAL DX, MEDICAL DX/PROBLEMS ONLY, OR SELECTED MEDICAL DX/PROBLEMS
+2 DO WAIT^DICD
DO GETSEL
+3 IF CHC>0
SET TXT="Would you like to list the contents of:"
SET MULT=1
SET ANS="NURCANS"
DO SELCHC^NURCCP2
IF NURCOUT!'$DATA(NURCANS)
SET X=$SELECT(NURCOUT:-1,1:0)
QUIT
+4 KILL ^TMP($JOB,"CPCH")
SET ^TMP($JOB,"CPCH",1)="1^Medical DX only"
SET ^(2)="2^Medical DX/Problems only"
SET ^(3)="3^Selected Medical DX/Problems"
SET CHC=3
SET TXT="Would you like to print:"
SET MULT=0
SET ANS="NURCDAT"
DO SELCHC^NURCCP2
+5 IF NURCOUT!'$DATA(NURCDAT)
SET X=$SELECT(NURCOUT:-1,1:0)
QUIT
+6 IF +NURCDAT>0
KILL NURCSECT
XECUTE "F X=0:0 S X=$O(NURCANS(X)) Q:X'>0 S NURCSECT(X)=NURCANS(X)"
IF +NURCDAT=3
SET X=2
QUIT
+7 DO WAIT^DICD
DO GETSEL
+8 KILL NURCSECT
FOR X=0:0
SET X=$ORDER(^TMP($JOB,"CPCH",X))
if X'>0
QUIT
SET CHC=$GET(^TMP($JOB,"CPCH",X))
IF +CHC>0
SET NURCSECT(+CHC)=CHC
+9 DO GETSEL
KILL ^TMP($JOB,"CPCH")
+10 IF +NURCDAT=2
SET X=""
FOR
SET X=$ORDER(^TMP($JOB,"PDOC",X))
if X=""
QUIT
FOR Y=0:0
SET Y=$ORDER(^TMP($JOB,"PDOC",X,Y))
if Y'>0
QUIT
FOR Z=0:0
SET Z=$ORDER(^TMP($JOB,"PDOC",X,Y,Z))
if Z'>0
QUIT
SET ^TMP($JOB,"PROB",Z,X,Y)=$GET(^TMP($JOB,"PDOC",X,Y,Z))
+11 SET X=1
+12 QUIT
