- 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 Mar 13, 2025@21:23:06 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
