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

IVMYZ3.m

Go to the documentation of this file. 
  1. IVMYZ3 ;ALB/SEK - PURGE INCORRECT IVM PATIENT & TRANSMISSION RECORDS ; 13-JUNE-95
  1.  ;;Version 2.0 ; INCOME VERIFICATION MATCH ;**3**; 21-OCT-94
  1.  ;
  1. EN ; this routine will delete ivm patient (#301.5) and ivm
  1.  ; transmission log (#301.6) records for incorrect income years of
  1.  ; -10000 & -910000.
  1.  ; this routine will also send notification to the IVM Center once
  1.  ; the facility has installed IVM*2*3 patch. 
  1.  ;
  1.  S IVMQUIT="" D ENV I '$D(IVMQUIT) W !,"PATCH IVM*2*3 INITIALIZATION ABORTED..." G Q
  1.  D TYPE Q:'$D(IVMPROD)
  1.  D PURGE
  1.  D NOTE
  1. Q K IVMQUIT,IVMPROD
  1.  Q
  1.  ;
  1. ENV ; make sure required patches are installed
  1.  N X
  1.  S X="DGDEP" X ^%ZOSF("TEST") E  K IVMQUIT W !?3,*7,"Patch DG*5.3*45 must be installed first!"
  1.  S X="IVMUM9" X ^%ZOSF("TEST") E  K IVMQUIT W !?3,*7,"Patch IVM*2*1 must be installed first!"
  1.  I '$F($T(+2^DGMTCOU1),54) K IVMQUIT W !?3,*7,"Patch DG*5.3*54 must be installed first!"
  1.  Q
  1.  ;
  1. TYPE ; Ask user if this installation is for a test account or live account.
  1.  N I
  1.  S DIR(0)="SM^1:PRODUCTION;0:TEST"
  1.  S DIR("A")="Enter type of account you are installing in"
  1.  S DIR("?")="Enter P for production account or T for test account"
  1.  F I=1:1 S X=$P($T(TEXT+I),";;",2) Q:X="QUIT"  S DIR("?",I)=X
  1.  D ^DIR
  1.  I Y=""!(Y["^") W:Y="" !!,*7,"User Timed Out, Process Aborted..."
  1.  S IVMPROD=Y
  1.  K DIR,DTOUT,DUOUT,DIRUT,DIROUT,X,Y
  1.  I IVMPROD=""!(IVMPROD["^") K IVMPROD Q
  1.  Q
  1.  ;
  1.  ;
  1. NOTE ; Send notification to the IVM Center once the facility has installed
  1.  ; IVM*2*3 patch in production account.
  1.  ;
  1.  I 'IVMPROD K IVMPROD Q
  1.  N DIFROM
  1.  W !!,"Sending a 'completed installation' notice to the IVM Center... "
  1.  S XMSUB="IVM*2*3 PATCH INSTALLATION"
  1.  S XMDUZ="IVM PACKAGE"
  1.  S XMY("WEATHERLY@IVM.DOMAIN.EXT")="",XMY(DUZ)="",XMY(.5)=""
  1.  S XMTEXT="IVMTEXT("
  1.  S IVMX=$$SITE^VASITE
  1.  S IVMTEXT(1)="  Facility:                   "_$P(IVMX,"^",2)
  1.  S IVMTEXT(2)="  Station Number:             "_$P(IVMX,"^",3)
  1.  ;
  1.  D NOW^%DTC S Y=% D DD^%DT
  1.  S IVMTEXT(3)="  Installed IVM*2*3 patch on: "_Y
  1.  D ^XMD W "done."
  1.  K IVMPROD,IVMTEXT,IVMX,XMDUZ,XMSUB,XMTEXT,XMY,%
  1.  Q
  1.  ;
  1.  ;
  1. PURGE ;  do the purge
  1.  S IVMCTR=0
  1.  F IVMYR=-10000,-910000 D
  1.  .S DFN="" F  S DFN=$O(^IVM(301.5,"AYR",IVMYR,DFN)) Q:'DFN  D
  1.  ..S IVMDA=0 F  S IVMDA=$O(^IVM(301.5,"AYR",IVMYR,DFN,IVMDA)) Q:'IVMDA  D  S DIK="^IVM(301.5,",DA=IVMDA D ^DIK S IVMCTR=IVMCTR+1
  1.  ...S IVMTR=0 F  S IVMTR=$O(^IVM(301.6,"B",IVMDA,IVMTR)) Q:'IVMTR  D
  1.  ....S DIK="^IVM(301.6,",DA=IVMTR D ^DIK
  1.  ;
  1.  W !!,"  Total number of IVM PATIENT (#301.5) records deleted: "_IVMCTR
  1.  K DA,DFN,DIK,IVMYR,IVMDA,IVMTR,IVMCTR
  1.  Q
  1.  ;
  1.  ;
  1. TEXT ; Text for help for production/test question
  1.  ;;If you are currently installing this IVM patch in a production
  1.  ;;account, you must answer P.  If you are installing in a test account
  1.  ;;you must answer T.
  1.  ;;
  1.  ;;The answer to this question is extremely important as it determines
  1.  ;;where income data for patients gets transmitted.  Test data must not
  1.  ;;be transmitted to the IVM Center's production account.  Production
  1.  ;;data, likewise, will not be evaluated properly if it is not sent to
  1.  ;;the IVM Center's production account.
  1.  ;;
  1.  ;;Enter '^' to abort this process.
  1.  ;;
  1.  ;;QUIT