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 ---[H[J[2J[HNUR22PST 960 printed Dec 13, 2024@02:18:03 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
