source: FOIAVistA/trunk/r/NURSING_SERVICE-NUR/NURCCP1.m@ 1250

NURCCP1 ;HIRMFO/RM,RTK-STANDARD CARE PLAN, PRINT (main routine) ;8/29/96
 ;;4.0;NURSING SERVICE;;Apr 25, 1997
EN1 ; ENTRY FROM NURCFP-CARE OPTION
 Q:$P($G(^DIC(213.9,1,"OFF")),"^")=1
 S NURCRT=$O(^GMRD(124.2,"AA","NURSC",2,"Nursing Care Plan",1,0)),NURCRT=NURCRT_"^"_$P($G(^GMRD(124.2,+NURCRT,0)),"^") I +NURCRT'>0!'$L($P(NURCRT,"^",2)) W !!,$C(7),"COULD NOT FIND NURSING CARE PLAN ENTRY IN AGGREGATE TERM FILE!!",!! G Q1
 S NURCPROB=$O(^GMRD(124.25,"AA","NURSC","NURSING PROBLEM",0)) I +NURCPROB'>0 W !!,$C(7),"COULD NOT FIND NURSING PROBLEM ENTRY IN TERM CLASSIFICATION FILE!!",!! G Q1
 S NURCDX=$O(^GMRD(124.25,"AA","NURSC","MEDICAL DX/PROCEDURE",0)) I +NURCDX'>0 W !!,$C(7),"COULD NOT FIND MEDICAL DX/PROCEDURE ENTRY IN TERM CLASSIFICATION FILE!!",!! G Q1
 S NURCEOPG=$S(IOSL-4>0:IOSL-4,1:20),NURCOUT=0,NURXXX=""
SECT ; SELECT WHICH SECTION TO PRINT
 K NURCSECT S NURCSECT(+NURCRT)=NURCRT K ^TMP($J,"PDOC"),^("LVL"),^("PARN"),^("PROB") D GETSEL^NURCCP3 S TXT="Would you like to list the contents of:",MULT=0,ANS="NURCANS" D SELCHC^NURCCP2
 G Q1:'$D(NURCANS) K NURCSECT S NURCSECT(+NURCANS)=NURCANS
 S NURCMS=$O(^GMRD(124.2,"AA","NURSC",2,"Medical Diagnoses",1,0)) I +NURCMS,$D(NURCSECT(+NURCMS)) D MEDSECT^NURCCP3 S:X=1 NURCPDAT=7 G SECT:'X,Q1:X<0,DEV:X=1
 D GETPROB^NURCCP3 G Q1:NURCOUT,SECT:'$D(^TMP($J,"PDOC"))
INFO ; SELECT WHICH INFO FOR SECTION TO PRINT
 K ^TMP($J,"CPCH"),^("PARN")
 S ^TMP($J,"CPCH",1)="1^All Nursing Problems in Selection",^(2)="2^Selected Nursing Problems from Selection",CHC=2,TXT="Enter type of information you want printed:",MULT=0,ANS="NURCINFO" D SELCHC^NURCCP2
 G Q1:NURCOUT,SECT:'$D(NURCINFO)
 D WAIT^DICD K ^TMP($J,"PROB")
 I +NURCINFO=1 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))
 I  G CPDATA
PROB ; CHOOSE SELECTED PROBLEMS
 K ^TMP($J,"CPCH") S NURCCHC=0
 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  S Z=$O(^TMP($J,"PDOC",X,Y,0)),NURCCHC=NURCCHC+1,^TMP($J,"CPCH",NURCCHC)=$G(^TMP($J,"PDOC",X,Y,+Z)) D DX
 S CHC=NURCCHC,TXT="Select from the following Problems:",MULT=1,ANS="NURCANS" D SELCHC^NURCCP2 G Q1:NURCOUT,SECT:'$D(NURCANS)
 D WAIT^DICD F Z=0:0 S Z=$O(NURCANS(Z)) Q:Z'>0  S X=$P(NURCANS(Z),"^",2),Y=$$UP^XLFSTR(X) F X=0:0 S X=$O(^TMP($J,"PDOC",Y,Z,X)) Q:X'>0  S ^TMP($J,"PROB",X,Y,Z)=NURCANS(Z)
CPDATA ; WHICH CARE PLAN DATA TO PRINT
 K ^TMP($J,"CPCH"),^("PDOC")
 S ^TMP($J,"CPCH",1)="1^Nursing Problems/Outcomes",^(2)="2^Nursing Problems/Interventions",^(3)="3^Nursing Problems/Etiologies",^(4)="4^Nursing Problems/Related Problems",^(5)="5^Nursing Problems/Defining Characteristics"
 S ^TMP($J,"CPCH",6)="6^All of the above",^(7)="7^Nursing Problems Only",CHC=7,TXT="For each care plan, which data should be printed:",MULT=1,ANS="NURCPDAT" D SELCHC^NURCCP2 G Q1:NURCOUT,SECT:'$D(NURCPDAT)
DEV ;
 S ZTSAVE("^TMP($J,""LVL"",")="",ZTSAVE("^TMP($J,""PROB"",")="",ZTDESC="Standard Care Plan Print",ZTRTN="PRINT^NURCCP1" W ! D EN7^NURSUT0 I POP!$D(ZTSK) K ZTSK D ^%ZISC G Q1:POP,SECT
 K ^TMP($J,"CPCH"),^("CPPH")
PRINT ; BEGIN PRINTING THIS DOCUMENT
 D PRINT^NURCCP4
 D CLOSE^NURSUT1 S NURCOUT=$G(NUROUT)
 G:'NURCOUT&'$D(ZTSK) SECT
Q1 ;
 K ^TMP($J) D ^NURCKILL
 Q
DX ; IF PARENT IS DX THEN STORE THIS IN CPCH ARRAY
 F NURC=1:1 Q:Z'>0  S NURCDX(0)=$G(^GMRD(124.2,+Z,0)) S:$P(NURCDX(0),"^",4)=NURCDX&$L($P(NURCDX(0),"^")) ^TMP($J,"CPCH",NURCCHC,NURC)=Z_"^"_$P(NURCDX(0),"^") S Z=$O(^TMP($J,"PDOC",X,Y,Z))
 Q