Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DG53P423

DG53P423.m

Go to the documentation of this file. 
  1. DG53P423 ;ALB/RPM - Pre/Post-Install;Nov 13, 2001 ; 1/16/02 3:33pm
  1.  ;;5.3;Registration;**423**;Aug 13, 1993
  1.  ;
  1.  ;
  1. ENV ;Main entry point for Environment check point.
  1.  ;
  1.  S XPDABORT=""
  1.  D PROGCHK(.XPDABORT) ;checks programmer variables
  1.  I XPDABORT="" K XPDABORT
  1.  Q
  1.  ;
  1.  ;
  1. PRE ;Main entry point for Pre-init items.
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. POST ;Main entry point for Post-init items.
  1.  ;
  1.  D POST1  ;rebuild 'AST' index for file #28.11
  1.  D POST2  ;requeue Head and Neck Cancer PTF messages
  1.  Q
  1.  ;
  1.  ;
  1. PROGCHK(XPDABORT) ;checks for necessary programmer variables
  1.  ;
  1.  I '$G(DUZ)!($G(DUZ(0))'="@")!('$G(DT))!($G(U)'="^") DO
  1.  .D BMES^XPDUTL("*****")
  1.  .D MES^XPDUTL("Your programming variables are not set up properly.")
  1.  .D MES^XPDUTL("Installation aborted.")
  1.  .D MES^XPDUTL("*****")
  1.  .S XPDABORT=2
  1.  Q
  1.  ;
  1. POST1 ;Rebuild the "AST" index for file #28.11
  1.  N DIK,X
  1.  I '$D(^DGNT(28.11,"AST")) D  Q
  1.  . D BMES^XPDUTL(" Re-index of 'AST' cross reference not needed.")
  1.  D BMES^XPDUTL(" Please be patient while I re-index the 'AST' cross reference.")
  1.  K ^DGNT(28.11,"AST")
  1.  S DIK="^DGNT(28.11,",DIK(1)=".03^AST"
  1.  D ENALL^DIK
  1.  D BMES^XPDUTL(" The NOSE AND THROAT RADIUM HISTORY file (#28.11) 'AST' x-ref re-indexed.")
  1.  Q
  1.  ;
  1. POST2 ;Set up TaskMan to re-queue PTF records in the background
  1.  N ZTDESC,ZTDTH,ZTIO,ZTQUEUED,ZTREQ,ZTRTN,ZTSAVE,ZTSK
  1.  S ZTRTN="SCAN^DG53P423"
  1.  S ZTDESC="Re-queue PTF records for DG*5.3*423"
  1.  ;Queue Task to start in 60 seconds
  1.  S ZTDTH=$$SCH^XLFDT("60S",$$NOW^XLFDT)
  1.  S ZTIO=""
  1.  D ^%ZTLOAD
  1.  D BMES^XPDUTL("*****")
  1.  D
  1.  . I $D(ZTSK)[0 D  Q
  1.  . .D MES^XPDUTL("TaskMan run to requeue PTF records for DG*5.3*423 was not started.")
  1.  . .D MES^XPDUTL("Re-run Post Install routine POST2^DG53P423.")
  1.  . D MES^XPDUTL("Task "_ZTSK_" started to requeue PTF records.")
  1.  . I $D(ZTSK("D")) D
  1.  . . D MES^XPDUTL("Task will start at "_$$HTE^XLFDT(ZTSK("D")))
  1.  D MES^XPDUTL("*****")
  1.  Q
  1.  ;
  1. SCAN ;Scan the Nose and Throat Radium History file (#28.11) for patients
  1.  ;who have a Screening Status of either 4:VERIFIED MILITARY MEDICAL
  1.  ;RECORD AND DIAGNOSIS or 5:VERIFIED SERVICE RECORD AND DIAGNOSIS.
  1.  ;Search the PTF records for any messages that would have
  1.  ;been transmitted to the NPCD after the verification date and re-queue
  1.  ;those messages.
  1.  ;
  1.  N DGSTART   ;Job start date/time
  1.  N DGTOTCNT  ;count of verified patients
  1.  N DGPTFCNT  ;count of re-queued PTF records
  1.  N DGMSG     ;free text message/line count passed to NOTIFY
  1.  N DGSTAT    ;NTR Status value
  1.  N DGIEN     ;IEN for NTR History file
  1.  N DGX       ;generic index counter
  1.  N DGNT      ;array of NTR History file nodes
  1.  N DGDTTMP   ;temporary value of NTR verification date
  1.  N DGDFN     ;IEN to PATIENT file (#2)
  1.  N DGDT      ;NTR verification date
  1.  N DGPTFARR  ;array of PTF records to re-queue
  1.  N DGQUIT    ;job control flag
  1.  ;
  1.  S DGSTART=$$NOW^XLFDT
  1.  S (DGMSG,DGQUIT,DGTOTCNT)=0
  1.  S DGPTFCNT="0^0"
  1.  S ZTREQ="@"  ;delete task when finished
  1.  L +^DGP(45.83):3 I '$T D  Q
  1.  . S DGMSG=2
  1.  . S DGMSG(1)="PTF Transmission Currently Running - Patch Re-queue Job Stopping"
  1.  . S DGMSG(2)="Re-run Post Install routine POST2^DG53P423."
  1.  . D NOTIFY(DGSTART,DGTOTCNT,DGPTFCNT,.DGMSG)
  1.  S DGDFN=0
  1.  F  S DGDFN=$O(^DGNT(28.11,"APR",DGDFN)) Q:'DGDFN  D  Q:DGQUIT
  1.  . K DGPTFARR
  1.  . S DGIEN=$O(^DGNT(28.11,"APR",DGDFN,1,0))
  1.  . Q:'DGIEN
  1.  . S DGDT=0
  1.  . F DGX=0:1:2 D
  1.  . . S DGNT(DGX)=$G(^DGNT(28.11,DGIEN,DGX))
  1.  . . S DGDTTMP=+$P(DGNT(DGX),U,$S(DGX=0:7,1:2))  ;get date field
  1.  . . I DGDTTMP>DGDT S DGDT=DGDTTMP
  1.  . Q:'DGDT
  1.  . Q:".4.5."'[("."_$P(DGNT(0),U,3)_".")    ;only verified N/T
  1.  . S DGTOTCNT=DGTOTCNT+1
  1.  . ;search for any PTF records that were xmit'ed and re-queue them
  1.  . I $$GETPTF(DGDFN,DGDT,.DGPTFARR) D REQPTF(.DGPTFARR,.DGPTFCNT)
  1.  . I $$S^%ZTLOAD D  Q
  1.  . . S DGMSG=2
  1.  . . S DGMSG(1)="Patch DG*5.3*423 PTF Re-queue Task Stopped by User"
  1.  . . S DGMSG(2)="Re-run Post Install routine POST2^DG53P423."
  1.  . . S (ZTSTOP,DGQUIT)=1
  1.  L -^DGP(45.83)
  1.  D NOTIFY(DGSTART,DGTOTCNT,DGPTFCNT,.DGMSG)
  1.  Q
  1.  ;
  1. GETPTF(DFN,DGDAT,DGPT) ;Find PTF records transmitted after the verification
  1.  ; date.  Build array subscripted by record numbers set equal to the
  1.  ; PTF record type.
  1.  ;
  1.  ;  Input
  1.  ;    DFN   - IEN to PATIENT file (#2)
  1.  ;    DGDAT - date of NTR verification
  1.  ;    DGPT - array node passed by reference
  1.  ;
  1.  ;  Output
  1.  ;    DGPT - array of PTF record types and queue dates (1:PTF,2:CENSUS)
  1.  ;           subscripted by PTF record # (ex. DGPT(1402)=2^3011212)
  1.  ;    function result - 0 : no records found
  1.  ;                      1 : records found
  1.  ;
  1.  N DGPTF  ;PTF record number (file #45 IEN)
  1.  N DGQDT  ;Date Queued
  1.  N DGRTY  ;Record type
  1.  N DGPT0  ;zero node of patient's PTF record
  1.  ;
  1.  I '$D(^DGPT("B",DFN)) Q 0
  1.  S DGPTF=0
  1.  F  S DGPTF=$O(^DGPT("B",DFN,DGPTF)) Q:'DGPTF  D
  1.  . ;borrowed from DIC("S") in DREL^DGPTFDEL
  1.  . I $D(^DGPT(DGPTF,0)),$D(^DGPT(DGPTF,70)),+^DGPT(DGPTF,70)>2901000,$D(^DGP(45.83,"C",DGPTF)) D
  1.  . . S DGPT0=^DGPT(DGPTF,0),DGRTY=$P(DGPT0,U,11)
  1.  . . S DGQDT=$O(^DGP(45.83,"C",DGPTF,0))
  1.  . . I DGQDT_".999999">DGDAT,DGRTY>0,DGRTY<3 S DGPT(DGPTF)=DGRTY_U_DGQDT
  1.  Q ($D(DGPT)>0)
  1.  ;
  1. REQPTF(DGPTFT,DGPTFC) ;Re-queue the PTF record for transmission
  1.  ;  Input
  1.  ;    DGPTFT - array of PTF record #'s to resend for a patient
  1.  ;    DGPTFC - count of re-queued PTF records
  1.  ;
  1.  ;  Output
  1.  ;    DGPTFC - count of re-queued PTF records PTF^CENSUS
  1.  ;             (ex.  DGPTFC=4^1)
  1.  ;
  1.  N DGPTF  ;PTF record number
  1.  N DGRTY  ;PTF record type (1:PTF, 2:CENSUS)
  1.  N DGDAT  ;Date of queuing for previous transmission
  1.  ;
  1.  S DGPTF=0
  1.  F  S DGPTF=$O(DGPTFT(DGPTF)) Q:'DGPTF  D
  1.  . S DGRTY=+DGPTFT(DGPTF),DGDAT=$P(DGPTFT(DGPTF),U,2)
  1.  . I $$UNREL(DGPTF,DGDAT) D RELEASE(DGPTF) S $P(DGPTFC,U,DGRTY)=$P(DGPTFC,U,DGRTY)+1
  1.  Q
  1.  ;
  1. UNREL(DGPTF,DGDT) ;Unrelease the PTF record - borrowed from OK^DGPTFDEL
  1.  ;
  1.  ;  Input:
  1.  ;    DGPTF - PTF record number
  1.  ;    DGDT  - Date of Previously Queued Transmission
  1.  ;
  1.  ;  Output:
  1.  ;    function result 1:success, 0:failure
  1.  ;
  1.  N DA,DIK  ;FileMan variables
  1.  ;
  1.  S DA(1)=DGDT
  1.  I 'DA(1) Q 0
  1.  S DIK="^DGP(45.83,"_DA(1)_",""P"",",DA=DGPTF D ^DIK
  1.  Q 1
  1.  ;
  1. RELEASE(DGPTF) ;Re-release the PTF record - borrowed from REL^DGPTFREL
  1.  ;
  1.  ;  Input:
  1.  ;    DGPTF - PTF record number
  1.  ;
  1.  ;  Output:
  1.  ;    none
  1.  ;
  1.  N DA,DIC,DIE,DINUM,DR,X  ;FileMan variables
  1.  ;
  1.  ;if date entry doesn't exist then create new entry and "P" node
  1.  I '$D(^DGP(45.83,DT,0)) D
  1.  . S (DINUM,X)=DT,DIC="^DGP(45.83,",DIC(0)="L"
  1.  . K DD,DO
  1.  . D FILE^DICN
  1.  . K DINUM,DIC
  1.  I '($D(^DGP(45.83,DT,"P",0))#2) S ^DGP(45.83,DT,"P",0)="^45.831PA^0^0"
  1.  ;if transmission date exists then clear it to allow re-transmission
  1.  I $P(^DGP(45.83,DT,0),U,2) D
  1.  . S DA=DT,DIE="^DGP(45.83,",DR="1///@"
  1.  . D ^DIE
  1.  . K DA,DIE,DR
  1.  ;add the PTF record to the queue
  1.  S (DINUM,X)=DGPTF,DIC(0)="L",DA(1)=DT,DIC="^DGP(45.83,"_DT_",""P"","
  1.  D FILE^DICN
  1.  K DA,DIC,DINUM
  1.  ;update RELEASE DATE and RELEASED BY fields in PTF CLOSE OUT file.
  1.  S DA=DGPTF,DIE="^DGP(45.84,",DR="4////"_DT_";5////"_DUZ
  1.  D ^DIE
  1.  K DA,DIE,DR
  1.  Q
  1.  ;
  1. NOTIFY(DGSTIME,DGTOT,DGPTFNUM,DGMESS) ;send job msg
  1.  ;
  1.  ;  Input
  1.  ;    DGSTIME - job start date/time
  1.  ;    DGTOT - count of patients checked
  1.  ;    DGPTFNUM - count of PTF messages re-queued
  1.  ;    DGMESS - free text message array for task stop or errors passed
  1.  ;             by reference
  1.  ;
  1.  ;  Output
  1.  ;    none
  1.  ;
  1.  N DIFROM,XMDUZ,XMSUB,XMTEXT,XMY,XMZ
  1.  N DGSITE,DGETIME,DGTEXT,DGI
  1.  S DGSITE=$$SITE^VASITE
  1.  S DGETIME=$$NOW^XLFDT
  1.  S XMDUZ="PTF Re-queue"
  1.  S XMSUB="Patch DG*5.3*423 Mill Bill Co-Pay Enhancements"
  1.  S XMTEXT="DGTEXT("
  1.  S XMY(DUZ)=""
  1.  S DGTEXT(1)=""
  1.  S DGTEXT(2)="          Facility Name:  "_$P(DGSITE,U,2)
  1.  S DGTEXT(3)="         Station Number:  "_$P(DGSITE,U,3)
  1.  S DGTEXT(4)=""
  1.  S DGTEXT(5)="  Date/Time job started:  "_$$FMTE^XLFDT(DGSTIME)
  1.  S DGTEXT(6)="  Date/Time job stopped:  "_$$FMTE^XLFDT(DGETIME)
  1.  S DGTEXT(7)=""
  1.  I $G(DGMESS) D
  1.  . F DGI=1:1:DGMESS D
  1.  . . S DGTEXT(7+DGI)="*** "_$E($G(DGMESS(DGI)),1,65)
  1.  I '$G(DGMESS) D
  1.  . S DGTEXT(8)="PTF Message Re-queue Complete"
  1.  . S DGTEXT(9)="Total Verified patients in file (#28.11): "_DGTOT
  1.  . S DGTEXT(10)="Total PTF     records re-queued: "_$P(DGPTFNUM,U,1)
  1.  . S DGTEXT(11)="Total CENSUS  records re-queued: "_$P(DGPTFNUM,U,2)
  1.  D ^XMD
  1.  Q