NURCPP0.m

NURCPP0 ;HIRMFO/RM-NURSING CARE PLAN PATIENT EDIT ;8/29/96

 ;;4.0;NURSING SERVICE;;Apr 25, 1997

EN1 ; ENTRY FROM OPTION NURCPE-CARE

 Q:$P($G(^DIC(213.9,1,"OFF")),"^")=1

 S NURSPK="NURSC"

 S NURSROOT=$O(^GMRD(124.2,"AA",NURSPK,2,"Nursing Care Plan",1,0)) I NURSROOT'>0 W !,$C(7),"CANNOT FIND THE 'Nursing Care Plan' ENTRY IN THE AGGREGATE TERM FILE" G Q1

 S GMRGRT=NURSROOT_"^"_$S($D(^GMRD(124.2,NURSROOT,0)):$P(^(0),"^"),1:"")

 S DIC(0)="EMQ",NASK=1,NACT=0 D EN7^NURSCUTL G:DFN'>0 Q1

PLAN S GMRGXPRT="0^1^1" D EN1^GMRGRUT3 G Q1:GMRGOUT!(+GMRGPDA'>0) I $P(GMRGPDA,"^",2)="@" G PLAN

GMRG S NURSCPE=$O(^NURSC(216.8,"B",GMRGPDA,0)) D:NURSCPE'>0 NEWPL G:NURSCPE'>0 Q1 D EN3^GMRGED0 G:'GMRGOUT EN1

Q1 D ^NURCKILL

 Q

NEWPL ;

 S X=GMRGPDA,DIC="^NURSC(216.8,",DIC(0)="Q" K DD D FILE^DICN S NURSCPE=+Y

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---NURCPP0   810     printed  Apr 09, 2024@21:22:07                                                                                                                                                                                                      Page 2

NURCPP0   ;HIRMFO/RM-NURSING CARE PLAN PATIENT EDIT ;8/29/96

 +1       ;;4.0;NURSING SERVICE;;Apr 25, 1997

EN1       ; ENTRY FROM OPTION NURCPE-CARE

 +1        if $PIECE($GET(^DIC(213.9,1,"OFF")),"^")=1

               QUIT 

 +2        SET NURSPK="NURSC"

 +3        SET NURSROOT=$ORDER(^GMRD(124.2,"AA",NURSPK,2,"Nursing Care Plan",1,0))

           IF NURSROOT'>0

               WRITE !,$CHAR(7),"CANNOT FIND THE 'Nursing Care Plan' ENTRY IN THE AGGREGATE TERM FILE"

               GOTO Q1

 +4        SET GMRGRT=NURSROOT_"^"_$SELECT($DATA(^GMRD(124.2,NURSROOT,0)):$PIECE(^(0),"^"),1:"")

 +5        SET DIC(0)="EMQ"

           SET NASK=1

           SET NACT=0

           DO EN7^NURSCUTL

           if DFN'>0

               GOTO Q1

PLAN       SET GMRGXPRT="0^1^1"

           DO EN1^GMRGRUT3

           if GMRGOUT!(+GMRGPDA'>0)

               GOTO Q1

           IF $PIECE(GMRGPDA,"^",2)="@"

               GOTO PLAN

GMRG       SET NURSCPE=$ORDER(^NURSC(216.8,"B",GMRGPDA,0))

           if NURSCPE'>0

               DO NEWPL

           if NURSCPE'>0

               GOTO Q1

           DO EN3^GMRGED0

           if 'GMRGOUT

               GOTO EN1

Q1         DO ^NURCKILL

 +1        QUIT 

NEWPL     ;

 +1        SET X=GMRGPDA

           SET DIC="^NURSC(216.8,"

           SET DIC(0)="Q"

           KILL DD

           DO FILE^DICN

           SET NURSCPE=+Y

 +2        QUIT