| 1 | NURCCP3 ;HIRMFO/RM-STANDARD CARE PLAN, PRINT (sort to get problems) ;3/9/92 | 
|---|
| 2 | ;;4.0;NURSING SERVICE;;Apr 25, 1997 | 
|---|
| 3 | GETPROB ; GO THROUGH EACH LEVEL OF CHILDREN FOR LIST OF PARENTS IN | 
|---|
| 4 | ; NURCSECT ARRAY UNTIL ALL PROBLEMS REACHED.  PROBLEMS ARE SET INTO | 
|---|
| 5 | ; ^TMP($J,"PDOC" | 
|---|
| 6 | D WAIT^DICD,GETSEL | 
|---|
| 7 | 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 | 
|---|
| 8 | Q | 
|---|
| 9 | GETSEL ; RETURNS CHC=NUMBER OF CHOICES IN ^TMP($J,"CPCH" | 
|---|
| 10 | ; ARRAY THAT WERE CHILDREN OF NURCSECT. | 
|---|
| 11 | K ^TMP($J,"CPPH"),^("CPCH") S CHC=0 | 
|---|
| 12 | F A=0:0 S A=$O(NURCSECT(A)) Q:A'>0  D HIER | 
|---|
| 13 | S Y=0,A="" F  S A=$O(^TMP($J,"CPPH",A)) Q:A=""  D G5 | 
|---|
| 14 | S CHC=Y | 
|---|
| 15 | Q | 
|---|
| 16 | SETPROB ; CONTINUATION OF FOR LOOP TO SET PROBLEM ARRAY OR CHC ARRAY | 
|---|
| 17 | S Y=$G(^GMRD(124.2,+X,0)) | 
|---|
| 18 | I $P(Y,"^",4)=NURCPROB S ^TMP($J,"PDOC",B,+X,A)=$P(X,"^",1,2) | 
|---|
| 19 | E  S ^TMP($J,"CPPH",B,+X)=$P(X,"^",1,2),^TMP($J,"PARN",+X,A)=$P(X,"^",1,2) | 
|---|
| 20 | Q | 
|---|
| 21 | HIER ; SET THE PATH DOWN TO THIS NODE FOR THE PRINT AND PROCESS THE CHILDREN | 
|---|
| 22 | 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)) | 
|---|
| 23 | 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 | 
|---|
| 24 | Q | 
|---|
| 25 | G5 ; CONTINUATION OF LINE GETSEL+5 | 
|---|
| 26 | 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)) | 
|---|
| 27 | Q | 
|---|
| 28 | MEDSECT ; PICK MEDICAL SECTIONS, THEN DETERMINE IF WILL ONLY PRINT | 
|---|
| 29 | ; MEDICAL DX, MEDICAL DX/PROBLEMS ONLY, OR SELECTED MEDICAL DX/PROBLEMS | 
|---|
| 30 | D WAIT^DICD,GETSEL | 
|---|
| 31 | 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 | 
|---|
| 32 | 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 | 
|---|
| 33 | I NURCOUT!'$D(NURCDAT) S X=$S(NURCOUT:-1,1:0) Q | 
|---|
| 34 | 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 | 
|---|
| 35 | D WAIT^DICD,GETSEL | 
|---|
| 36 | 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 | 
|---|
| 37 | D GETSEL K ^TMP($J,"CPCH") | 
|---|
| 38 | 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)) | 
|---|
| 39 | S X=1 | 
|---|
| 40 | Q | 
|---|