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

Last change on this file since 1757 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.5 KB
Line 
1NURCCP1 ;HIRMFO/RM,RTK-STANDARD CARE PLAN, PRINT (main routine) ;8/29/96
2 ;;4.0;NURSING SERVICE;;Apr 25, 1997
3EN1 ; ENTRY FROM NURCFP-CARE OPTION
4 Q:$P($G(^DIC(213.9,1,"OFF")),"^")=1
5 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
6 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
7 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
8 S NURCEOPG=$S(IOSL-4>0:IOSL-4,1:20),NURCOUT=0,NURXXX=""
9SECT ; SELECT WHICH SECTION TO PRINT
10 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
11 G Q1:'$D(NURCANS) K NURCSECT S NURCSECT(+NURCANS)=NURCANS
12 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
13 D GETPROB^NURCCP3 G Q1:NURCOUT,SECT:'$D(^TMP($J,"PDOC"))
14INFO ; SELECT WHICH INFO FOR SECTION TO PRINT
15 K ^TMP($J,"CPCH"),^("PARN")
16 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
17 G Q1:NURCOUT,SECT:'$D(NURCINFO)
18 D WAIT^DICD K ^TMP($J,"PROB")
19 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))
20 I G CPDATA
21PROB ; CHOOSE SELECTED PROBLEMS
22 K ^TMP($J,"CPCH") S NURCCHC=0
23 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
24 S CHC=NURCCHC,TXT="Select from the following Problems:",MULT=1,ANS="NURCANS" D SELCHC^NURCCP2 G Q1:NURCOUT,SECT:'$D(NURCANS)
25 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)
26CPDATA ; WHICH CARE PLAN DATA TO PRINT
27 K ^TMP($J,"CPCH"),^("PDOC")
28 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"
29 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)
30DEV ;
31 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
32 K ^TMP($J,"CPCH"),^("CPPH")
33PRINT ; BEGIN PRINTING THIS DOCUMENT
34 D PRINT^NURCCP4
35 D CLOSE^NURSUT1 S NURCOUT=$G(NUROUT)
36 G:'NURCOUT&'$D(ZTSK) SECT
37Q1 ;
38 K ^TMP($J) D ^NURCKILL
39 Q
40DX ; IF PARENT IS DX THEN STORE THIS IN CPCH ARRAY
41 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))
42 Q
Note: See TracBrowser for help on using the repository browser.