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