- 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 Jan 18, 2025@03:21:22 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