- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURCCP1 3575 printed Jan 18, 2025@03:21:20 Page 2
- 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