NUR22PST.m

NUR22PST ; HCIOFO/MD-Post-Init for Patch 22

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

 D BMES^XPDUTL("Removing duplicate problem entries from the Nurs Care Plan (#216.8) file....")

 K ^TMP($J) S NSW=0

 S NURDA=0 F  S NURDA=$O(^NURSC(216.8,NURDA)) Q:NURDA'>0  I $G(^NURSC(216.8,NURDA,0))'="" W:($E(IOST)="C"&$R(100)) "." D  K ^TMP($J) S NSW=0

 .  S NURD1=0 F  S NURD1=$O(^NURSC(216.8,NURDA,"PROB",NURD1)) Q:NURD1'>0  I '($G(^NURSC(216.8,NURDA,"PROB",NURD1,0))="") D

 .  .  S NURX=^NURSC(216.8,NURDA,"PROB",NURD1,0) I 'NSW D SETMP S NSW=1 Q

 .  .  I NSW,$D(^TMP($J,"NPREV",NURX)) D DUPROC Q

 .  .  D SETMP

 .  .  Q

 .  Q

QUIT K ^TMP($J),DA,DIK,NSW,NURDA,NURD1

 D BMES^XPDUTL("Done")

 Q

DUPROC ; PROCESS DUPLICATE

 ;

 S DA(1)=NURDA,DA=NURD1,DIK="^NURSC(216.8,DA(1),""PROB""," D ^DIK K DIK

 Q

SETMP ; SET TEMP GLOBAL

 S ^TMP($J,"NPREV",NURX)="" S:'$D(^NURSC(216.8,NURDA,"PROB","B",NURX,NURD1)) ^NURSC(216.8,NURDA,"PROB","B",NURX,NURD1)=""

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---NUR22PST   960     printed  Apr 09, 2024@21:23:23                                                                                                                                                                                                     Page 2

NUR22PST  ; HCIOFO/MD-Post-Init for Patch 22

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

 +2        DO BMES^XPDUTL("Removing duplicate problem entries from the Nurs Care Plan (#216.8) file....")

 +3        KILL ^TMP($JOB)

           SET NSW=0

 +4        SET NURDA=0

           FOR 

               SET NURDA=$ORDER(^NURSC(216.8,NURDA))

               if NURDA'>0

                   QUIT 

               IF $GET(^NURSC(216.8,NURDA,0))'=""

                   if ($EXTRACT(IOST)="C"&$RANDOM(100))

                       WRITE "."

                   Begin DoDot:1

 +5                    SET NURD1=0

                       FOR 

                           SET NURD1=$ORDER(^NURSC(216.8,NURDA,"PROB",NURD1))

                           if NURD1'>0

                               QUIT 

                           IF '($GET(^NURSC(216.8,NURDA,"PROB",NURD1,0))="")

                               Begin DoDot:2

 +6                                SET NURX=^NURSC(216.8,NURDA,"PROB",NURD1,0)

                                   IF 'NSW

                                       DO SETMP

                                       SET NSW=1

                                       QUIT 

 +7                                IF NSW

                                       IF $DATA(^TMP($JOB,"NPREV",NURX))

                                           DO DUPROC

                                           QUIT 

 +8                                DO SETMP

 +9                                QUIT 

                               End DoDot:2

 +10                   QUIT 

                   End DoDot:1

                   KILL ^TMP($JOB)

                   SET NSW=0

QUIT       KILL ^TMP($JOB),DA,DIK,NSW,NURDA,NURD1

 +1        DO BMES^XPDUTL("Done")

 +2        QUIT 

DUPROC    ; PROCESS DUPLICATE

 +1       ;

 +2        SET DA(1)=NURDA

           SET DA=NURD1

           SET DIK="^NURSC(216.8,DA(1),""PROB"","

           DO ^DIK

           KILL DIK

 +3        QUIT 

SETMP     ; SET TEMP GLOBAL

 +1        SET ^TMP($JOB,"NPREV",NURX)=""

           if '$DATA(^NURSC(216.8,NURDA,"PROB","B",NURX,NURD1))

               SET ^NURSC(216.8,NURDA,"PROB","B",NURX,NURD1)=""

 +2        QUIT