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