AFJXPNHX ;FO-OAKLAND/GMB-PURGE MSGS ;11/8/95
;;5.1;Network Health Exchange;**1,6,11,17,20,24,31**;Jan 23, 1996
; Totally rewritten 11/2001. (Previously FJ/CWS.)
; Entry points:
; ENTER - invoked by option AFJXNH PURGE NIGHTLY
ENTER ;
N AXCUTOFF
S AXCUTOFF=$$FMADD^XLFDT(DT,-7) ; Days to keep on file - OK to change
D NHX(AXCUTOFF)
D DELST
D NITE(AXCUTOFF)
Q
NHX(AXCUTOFF) ;
N AXNHEDUZ,AXBSKT,AXMZ,AXDATE,DUZ
S (DUZ,AXNHEDUZ)=$$FIND1^DIC(200,"","X","NETWORK,HEALTH EXCHANGE","B") Q:'AXNHEDUZ
S AXBSKT=.9
F S AXBSKT=$O(^XMB(3.7,AXNHEDUZ,2,AXBSKT)) Q:'AXBSKT D
. S AXMZ=0
. F S AXMZ=$O(^XMB(3.7,AXNHEDUZ,2,AXBSKT,1,AXMZ)) Q:'AXMZ D
. . S AXDATE=$P($G(^XMB(3.9,AXMZ,0)),U,3)
. . S AXDATE=$S(AXDATE[".":$P(AXDATE,".",1),1:$$CONVERT^XMXUTIL1(AXDATE))
. . I AXDATE'>AXCUTOFF D DELMSG^XMXAPI(AXNHEDUZ,"",AXMZ) Q
. . I $$NEW^XMXUTIL2(AXNHEDUZ,AXBSKT,AXMZ) D NONEW^XMXUTIL(AXNHEDUZ,AXBSKT,AXMZ)
Q
DELST ;
N AX25IEN,AX25REC,AXDOMIEN,AXDAYS,AXI,AXDTRCVD,DA,DIK,AXCUTOFF
S (AX25IEN,AXI)=0
F S AX25IEN=$O(^AFJ(537025,AX25IEN)) Q:'AX25IEN D
. S AX25REC=$G(^AFJ(537025,AX25IEN,0))
. S AXDOMIEN=$P(AX25REC,U),AXDAYS=$P(AX25REC,U,5) Q:AXDOMIEN=""!'AXDAYS
. S AXCUTOFF=$$FMADD^XLFDT(DT,-AXDAYS)
. F S AXI=$O(^AFJ(537000,"C",AXDOMIEN,AXI)) Q:'AXI D
. . S AXDTRCVD=$P($G(^AFJ(537000,AXI,0)),U,2) ; Date Received
. . I AXDTRCVD<AXCUTOFF S DIK="^AFJ(537000,",DA=AXI D ^DIK
Q
NITE(AXCUTOFF) ; Nightly purge of messages in the AFJX server baskets
N AXSRV,AXBSKT,AXMZ,AXDATE,XMZ,XMSER
F AXSRV="S.AFJXSERVER","S.AFJXNHDONE","S.AFJXNETP" D
. S AXBSKT=$$FIND1^DIC(3.701,",.5,","X",AXSRV,"B") Q:'AXBSKT
. S AXMZ=0
. F S AXMZ=$O(^XMB(3.7,.5,2,AXBSKT,1,AXMZ)) Q:'AXMZ D
. . I $G(^XMB(3.9,AXMZ,0))="" S XMZ=AXMZ,XMSER=AXSRV D REMSBMSG^XMA1C Q
. . S AXDATE=$P(^XMB(3.9,AXMZ,0),U,3)
. . S AXDATE=$S(AXDATE[".":$P(AXDATE,".",1),1:$$CONVERT^XMXUTIL1(AXDATE))
. . I AXDATE<AXCUTOFF S XMZ=AXMZ,XMSER=AXSRV D REMSBMSG^XMA1C
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HAFJXPNHX 1984 printed Sep 23, 2025@19:54:13 Page 2
AFJXPNHX ;FO-OAKLAND/GMB-PURGE MSGS ;11/8/95
+1 ;;5.1;Network Health Exchange;**1,6,11,17,20,24,31**;Jan 23, 1996
+2 ; Totally rewritten 11/2001. (Previously FJ/CWS.)
+3 ; Entry points:
+4 ; ENTER - invoked by option AFJXNH PURGE NIGHTLY
ENTER ;
+1 NEW AXCUTOFF
+2 ; Days to keep on file - OK to change
SET AXCUTOFF=$$FMADD^XLFDT(DT,-7)
+3 DO NHX(AXCUTOFF)
+4 DO DELST
+5 DO NITE(AXCUTOFF)
+6 QUIT
NHX(AXCUTOFF) ;
+1 NEW AXNHEDUZ,AXBSKT,AXMZ,AXDATE,DUZ
+2 SET (DUZ,AXNHEDUZ)=$$FIND1^DIC(200,"","X","NETWORK,HEALTH EXCHANGE","B")
if 'AXNHEDUZ
QUIT
+3 SET AXBSKT=.9
+4 FOR
SET AXBSKT=$ORDER(^XMB(3.7,AXNHEDUZ,2,AXBSKT))
if 'AXBSKT
QUIT
Begin DoDot:1
+5 SET AXMZ=0
+6 FOR
SET AXMZ=$ORDER(^XMB(3.7,AXNHEDUZ,2,AXBSKT,1,AXMZ))
if 'AXMZ
QUIT
Begin DoDot:2
+7 SET AXDATE=$PIECE($GET(^XMB(3.9,AXMZ,0)),U,3)
+8 SET AXDATE=$SELECT(AXDATE[".":$PIECE(AXDATE,".",1),1:$$CONVERT^XMXUTIL1(AXDATE))
+9 IF AXDATE'>AXCUTOFF
DO DELMSG^XMXAPI(AXNHEDUZ,"",AXMZ)
QUIT
+10 IF $$NEW^XMXUTIL2(AXNHEDUZ,AXBSKT,AXMZ)
DO NONEW^XMXUTIL(AXNHEDUZ,AXBSKT,AXMZ)
End DoDot:2
End DoDot:1
+11 QUIT
DELST ;
+1 NEW AX25IEN,AX25REC,AXDOMIEN,AXDAYS,AXI,AXDTRCVD,DA,DIK,AXCUTOFF
+2 SET (AX25IEN,AXI)=0
+3 FOR
SET AX25IEN=$ORDER(^AFJ(537025,AX25IEN))
if 'AX25IEN
QUIT
Begin DoDot:1
+4 SET AX25REC=$GET(^AFJ(537025,AX25IEN,0))
+5 SET AXDOMIEN=$PIECE(AX25REC,U)
SET AXDAYS=$PIECE(AX25REC,U,5)
if AXDOMIEN=""!'AXDAYS
QUIT
+6 SET AXCUTOFF=$$FMADD^XLFDT(DT,-AXDAYS)
+7 FOR
SET AXI=$ORDER(^AFJ(537000,"C",AXDOMIEN,AXI))
if 'AXI
QUIT
Begin DoDot:2
+8 ; Date Received
SET AXDTRCVD=$PIECE($GET(^AFJ(537000,AXI,0)),U,2)
+9 IF AXDTRCVD<AXCUTOFF
SET DIK="^AFJ(537000,"
SET DA=AXI
DO ^DIK
End DoDot:2
End DoDot:1
+10 QUIT
NITE(AXCUTOFF) ; Nightly purge of messages in the AFJX server baskets
+1 NEW AXSRV,AXBSKT,AXMZ,AXDATE,XMZ,XMSER
+2 FOR AXSRV="S.AFJXSERVER","S.AFJXNHDONE","S.AFJXNETP"
Begin DoDot:1
+3 SET AXBSKT=$$FIND1^DIC(3.701,",.5,","X",AXSRV,"B")
if 'AXBSKT
QUIT
+4 SET AXMZ=0
+5 FOR
SET AXMZ=$ORDER(^XMB(3.7,.5,2,AXBSKT,1,AXMZ))
if 'AXMZ
QUIT
Begin DoDot:2
+6 IF $GET(^XMB(3.9,AXMZ,0))=""
SET XMZ=AXMZ
SET XMSER=AXSRV
DO REMSBMSG^XMA1C
QUIT
+7 SET AXDATE=$PIECE(^XMB(3.9,AXMZ,0),U,3)
+8 SET AXDATE=$SELECT(AXDATE[".":$PIECE(AXDATE,".",1),1:$$CONVERT^XMXUTIL1(AXDATE))
+9 IF AXDATE<AXCUTOFF
SET XMZ=AXMZ
SET XMSER=AXSRV
DO REMSBMSG^XMA1C
End DoDot:2
End DoDot:1
+10 QUIT
