Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: NURCCP3

NURCCP3.m

Go to the documentation of this file.
  1. NURCCP3 ;HIRMFO/RM-STANDARD CARE PLAN, PRINT (sort to get problems) ;3/9/92
  1. ;;4.0;NURSING SERVICE;;Apr 25, 1997
  1. GETPROB ; GO THROUGH EACH LEVEL OF CHILDREN FOR LIST OF PARENTS IN
  1. ; NURCSECT ARRAY UNTIL ALL PROBLEMS REACHED. PROBLEMS ARE SET INTO
  1. ; ^TMP($J,"PDOC"
  1. D WAIT^DICD,GETSEL
  1. 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
  1. Q
  1. GETSEL ; RETURNS CHC=NUMBER OF CHOICES IN ^TMP($J,"CPCH"
  1. ; ARRAY THAT WERE CHILDREN OF NURCSECT.
  1. K ^TMP($J,"CPPH"),^("CPCH") S CHC=0
  1. F A=0:0 S A=$O(NURCSECT(A)) Q:A'>0 D HIER
  1. S Y=0,A="" F S A=$O(^TMP($J,"CPPH",A)) Q:A="" D G5
  1. S CHC=Y
  1. Q
  1. SETPROB ; CONTINUATION OF FOR LOOP TO SET PROBLEM ARRAY OR CHC ARRAY
  1. S Y=$G(^GMRD(124.2,+X,0))
  1. I $P(Y,"^",4)=NURCPROB S ^TMP($J,"PDOC",B,+X,A)=$P(X,"^",1,2)
  1. E S ^TMP($J,"CPPH",B,+X)=$P(X,"^",1,2),^TMP($J,"PARN",+X,A)=$P(X,"^",1,2)
  1. Q
  1. HIER ; SET THE PATH DOWN TO THIS NODE FOR THE PRINT AND PROCESS THE CHILDREN
  1. 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))
  1. 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
  1. Q
  1. G5 ; CONTINUATION OF LINE GETSEL+5
  1. 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))
  1. Q
  1. MEDSECT ; PICK MEDICAL SECTIONS, THEN DETERMINE IF WILL ONLY PRINT
  1. ; MEDICAL DX, MEDICAL DX/PROBLEMS ONLY, OR SELECTED MEDICAL DX/PROBLEMS
  1. D WAIT^DICD,GETSEL
  1. 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
  1. 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
  1. I NURCOUT!'$D(NURCDAT) S X=$S(NURCOUT:-1,1:0) Q
  1. 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
  1. D WAIT^DICD,GETSEL
  1. 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
  1. D GETSEL K ^TMP($J,"CPCH")
  1. 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))
  1. S X=1
  1. Q