DG531086P ;SLC/JLC - POST-INSTALL FOR DG*5.3*1086 ; Feb 28, 2023@14:32
;;5.3;Registration;**1086**;Aug 13, 1993;Build 12
;
; Reference to TIU(8925 supported in ICR #6154
Q
;
EN ; entry point
N ZTRTN,ZTSAVE,ZTSK,ZTDESC,ZTDTH,ZTIO,ZTSAVE
S ZTRTN="SEARCH^DG531086P",ZTDESC="Find Note Issues in Patient File"
S ZTIO="",ZTDTH=$H,ZTSAVE("DUZ")=""
D ^%ZTLOAD
I $G(ZTSK) D BMES^XPDUTL("Task to search for bad note pointers queued, task number: "_ZTSK)
I '$G(ZTSK) D BMES^XPDUTL("ERROR Tasking Search job. Please enter a SNOW ticket.")
Q
;
SEARCH ;search for dangling note pointers
;or pointers to notes for different patients
;remove pointer, as necessary
N S1,ERRCNT,ORNOW,ORNOW180,S2,DFN,SO1,NOTEIEN,PXRMINPUTS,TEMP,XMSUB,XMTEXT,XMY,TEXT,A,I,XMFLG
S S1=0,ERRCNT=0,ORNOW=$$NOW^XLFDT(),ORNOW180=$$FMADD^XLFDT(ORNOW,180)
S ^XTMP("DG531086P",0)=ORNOW180_"^"_ORNOW_"^Search for bad note pointers in sexual orientation"
F S S1=$O(^DPT("G202501",S1)) Q:'S1 D
. S S2=0
. F S S2=$O(^DPT("G202501",S1,S2)) Q:'S2 D
.. K PXRMINPUTS S DFN=0
.. F S DFN=$O(^DPT("G202501",S1,S2,DFN)) Q:'DFN D S ^XTMP("DG531086P",DFN,0)="COMPLETED",^XTMP("DG531086P",0,1)=DFN
... S ^XTMP("DG531086P",DFN,0)="STARTED"
... S SO1=0
... F S SO1=$O(^DPT(DFN,.025,SO1)) Q:'SO1 D
.... I $P($G(^DPT(DFN,.025,SO1,0)),"^",5)="" Q
.... S NOTEIEN=$P($G(^DPT(DFN,.025,SO1,0)),"^",5)
.... I $$GET1^DIQ(8925,NOTEIEN,.02,"I")=DFN Q
.... M ^XTMP("DG531086P",DFN,.025)=^DPT(DFN,.025) S ERRCNT=ERRCNT+1,ERRCNT(DFN)=""
.... S PXRMINPUTS("Note")=NOTEIEN
.... S TEMP=$$SOGI^VAFCAPI(DFN,.PXRMINPUTS,1)
.... I 'TEMP Q
.... S ^XTMP("DG531086P","ERROR",DFN)=TEMP
S XMY("CRUMLEY.JAMIE@DOMAIN.EXT")="",XMY("THOMPSON.WILLIAM_ANTHONY@DOMAIN.EXT")="",XMY("PULEO.ANTHONY_G@DOMAIN.EXT")=""
I $G(DUZ) S XMY(DUZ)=""
K ^TMP("DG531086P",$J)
S ^TMP("DG531086P",$J,1)="Sexual orientation note IEN cleanup has completed."
S ^TMP("DG531086P",$J,2)=" "
S ^TMP("DG531086P",$J,3)=$S('$D(^XTMP("DG531086P","ERROR")):"No e",1:"E")_"rrors have been reported."
S ^TMP("DG531086P",$J,4)=" "
S ^TMP("DG531086P",$J,5)=ERRCNT_" notes had cleanup performed."
S XMSUB="PATCH DG*5.3*1086 CLEANUP COMPLETED",XMTEXT="^TMP(""DG531086P"","_$J_"," D ^XMD
I 'ERRCNT Q
K XMY,TEXT
S TEXT(0,1)="Sexual orientation note IEN cleanup has completed."
S TEXT(0,2)=" "
S TEXT(0,3)=$S('$D(^XTMP("DG531086P","ERROR")):"No e",1:"E")_"rrors have been reported."
S TEXT(0,4)=" "
S TEXT(0,5)="The following patients had note cleanup performed:"
S TEXT(0,6)=" "
S TEXT(0,7)="PATIENT"
S TEXT(0,8)=" "
S DFN=""
F I=9:1 S DFN=$O(ERRCNT(DFN)) Q:DFN="" D
. S A=$G(^DPT(DFN,0)),TEXT(0,I)=$E($P(A,"^"),1)_$E($P(A,"^",9),6,9)
S XMSUB="PATCH DG*5.3*1086 CLEANUP COMPLETED",XMY("G.OR CACS")="",XMTEXT="TEXT(0)",XMFLG("FLAGS")="X"
D SENDMSG^XMXAPI($G(DUZ),XMSUB,XMTEXT,.XMY,.XMFLG)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDG531086P 2890 printed Oct 16, 2024@18:36:33 Page 2
DG531086P ;SLC/JLC - POST-INSTALL FOR DG*5.3*1086 ; Feb 28, 2023@14:32
+1 ;;5.3;Registration;**1086**;Aug 13, 1993;Build 12
+2 ;
+3 ; Reference to TIU(8925 supported in ICR #6154
+4 QUIT
+5 ;
EN ; entry point
+1 NEW ZTRTN,ZTSAVE,ZTSK,ZTDESC,ZTDTH,ZTIO,ZTSAVE
+2 SET ZTRTN="SEARCH^DG531086P"
SET ZTDESC="Find Note Issues in Patient File"
+3 SET ZTIO=""
SET ZTDTH=$HOROLOG
SET ZTSAVE("DUZ")=""
+4 DO ^%ZTLOAD
+5 IF $GET(ZTSK)
DO BMES^XPDUTL("Task to search for bad note pointers queued, task number: "_ZTSK)
+6 IF '$GET(ZTSK)
DO BMES^XPDUTL("ERROR Tasking Search job. Please enter a SNOW ticket.")
+7 QUIT
+8 ;
SEARCH ;search for dangling note pointers
+1 ;or pointers to notes for different patients
+2 ;remove pointer, as necessary
+3 NEW S1,ERRCNT,ORNOW,ORNOW180,S2,DFN,SO1,NOTEIEN,PXRMINPUTS,TEMP,XMSUB,XMTEXT,XMY,TEXT,A,I,XMFLG
+4 SET S1=0
SET ERRCNT=0
SET ORNOW=$$NOW^XLFDT()
SET ORNOW180=$$FMADD^XLFDT(ORNOW,180)
+5 SET ^XTMP("DG531086P",0)=ORNOW180_"^"_ORNOW_"^Search for bad note pointers in sexual orientation"
+6 FOR
SET S1=$ORDER(^DPT("G202501",S1))
if 'S1
QUIT
Begin DoDot:1
+7 SET S2=0
+8 FOR
SET S2=$ORDER(^DPT("G202501",S1,S2))
if 'S2
QUIT
Begin DoDot:2
+9 KILL PXRMINPUTS
SET DFN=0
+10 FOR
SET DFN=$ORDER(^DPT("G202501",S1,S2,DFN))
if 'DFN
QUIT
Begin DoDot:3
+11 SET ^XTMP("DG531086P",DFN,0)="STARTED"
+12 SET SO1=0
+13 FOR
SET SO1=$ORDER(^DPT(DFN,.025,SO1))
if 'SO1
QUIT
Begin DoDot:4
+14 IF $PIECE($GET(^DPT(DFN,.025,SO1,0)),"^",5)=""
QUIT
+15 SET NOTEIEN=$PIECE($GET(^DPT(DFN,.025,SO1,0)),"^",5)
+16 IF $$GET1^DIQ(8925,NOTEIEN,.02,"I")=DFN
QUIT
+17 MERGE ^XTMP("DG531086P",DFN,.025)=^DPT(DFN,.025)
SET ERRCNT=ERRCNT+1
SET ERRCNT(DFN)=""
+18 SET PXRMINPUTS("Note")=NOTEIEN
+19 SET TEMP=$$SOGI^VAFCAPI(DFN,.PXRMINPUTS,1)
+20 IF 'TEMP
QUIT
+21 SET ^XTMP("DG531086P","ERROR",DFN)=TEMP
End DoDot:4
End DoDot:3
SET ^XTMP("DG531086P",DFN,0)="COMPLETED"
SET ^XTMP("DG531086P",0,1)=DFN
End DoDot:2
End DoDot:1
+22 SET XMY("CRUMLEY.JAMIE@DOMAIN.EXT")=""
SET XMY("THOMPSON.WILLIAM_ANTHONY@DOMAIN.EXT")=""
SET XMY("PULEO.ANTHONY_G@DOMAIN.EXT")=""
+23 IF $GET(DUZ)
SET XMY(DUZ)=""
+24 KILL ^TMP("DG531086P",$JOB)
+25 SET ^TMP("DG531086P",$JOB,1)="Sexual orientation note IEN cleanup has completed."
+26 SET ^TMP("DG531086P",$JOB,2)=" "
+27 SET ^TMP("DG531086P",$JOB,3)=$SELECT('$DATA(^XTMP("DG531086P","ERROR")):"No e",1:"E")_"rrors have been reported."
+28 SET ^TMP("DG531086P",$JOB,4)=" "
+29 SET ^TMP("DG531086P",$JOB,5)=ERRCNT_" notes had cleanup performed."
+30 SET XMSUB="PATCH DG*5.3*1086 CLEANUP COMPLETED"
SET XMTEXT="^TMP(""DG531086P"","_$JOB_","
DO ^XMD
+31 IF 'ERRCNT
QUIT
+32 KILL XMY,TEXT
+33 SET TEXT(0,1)="Sexual orientation note IEN cleanup has completed."
+34 SET TEXT(0,2)=" "
+35 SET TEXT(0,3)=$SELECT('$DATA(^XTMP("DG531086P","ERROR")):"No e",1:"E")_"rrors have been reported."
+36 SET TEXT(0,4)=" "
+37 SET TEXT(0,5)="The following patients had note cleanup performed:"
+38 SET TEXT(0,6)=" "
+39 SET TEXT(0,7)="PATIENT"
+40 SET TEXT(0,8)=" "
+41 SET DFN=""
+42 FOR I=9:1
SET DFN=$ORDER(ERRCNT(DFN))
if DFN=""
QUIT
Begin DoDot:1
+43 SET A=$GET(^DPT(DFN,0))
SET TEXT(0,I)=$EXTRACT($PIECE(A,"^"),1)_$EXTRACT($PIECE(A,"^",9),6,9)
End DoDot:1
+44 SET XMSUB="PATCH DG*5.3*1086 CLEANUP COMPLETED"
SET XMY("G.OR CACS")=""
SET XMTEXT="TEXT(0)"
SET XMFLG("FLAGS")="X"
+45 DO SENDMSG^XMXAPI($GET(DUZ),XMSUB,XMTEXT,.XMY,.XMFLG)
+46 QUIT
