IVM20P19.m

IVM20P19 ;ALB/KCL - Post-Install Extract ; 1-SEP-1998

 ;;2.0;INCOME VERIFICATION MATCH;**19**; 21-OCT-94

 ;

 ;

POST ; Entry point for post-install, setup check points

 N %

 S %=$$NEWCP^XPDUTL("DFN","EN^IVM20P19",0)

 Q

 ;

 ;

EN ; Description: This entry point will be the driver for the extract.

 ;

 ;  Input: None

 ; Output: None

 ;

 N IVMARRAY,IVMBEGDT,IVMENDDT

 ;

 ; init variables (start/end date for search)

 S IVMBEGDT=2961001

 S IVMENDDT=DT

 ;

 ; perform extract, display results during post-install

 D BMES^XPDUTL("  Examining the PATIENT #2 file...")

 D EXTRACT(IVMBEGDT,IVMENDDT,.IVMARRAY)

 ;

 D MES^XPDUTL("    Total patients processed: "_IVMARRAY("PROC"))

 D MES^XPDUTL("    Total patients extracted: "_IVMARRAY("EXTRACT"))

 D MES^XPDUTL("        Percentage extracted: "_$S($G(IVMARRAY("PROC")):$P(IVMARRAY("EXTRACT")/IVMARRAY("PROC")*100,".")_"%",1:""))

 D MES^XPDUTL("")

 D MES^XPDUTL("  The "_IVMARRAY("EXTRACT")_" patients extracted will be included in the next daily")

 D MES^XPDUTL("  transmission(s) to the Health Eligibility Center (HEC).")

 ;

 ; send extract results bulletin

 D BMES^XPDUTL("  Sending extract results bulletin...")

 D BULL(.IVMARRAY)

 Q

 ;

 ;

EXTRACT(BEGDT,ENDDT,IVMARRAY) ; Description: Used to perform the extract and log patients in the IVM PATIENT file for transmission if selected.

 ;

 ;  Input:

 ;   BEGDT - as begin date for extract search

 ;   ENDDT - as end date for extract search

 ;

 ; Output:

 ;   IVMARRAY - as local array containing extract results, pass by reference

 ;

 N DFN

 ;

 ; init varibles

 K IVMARRAY S IVMARRAY=""

 S IVMARRAY("START")=$$NOW^XLFDT  ; current date/time started

 S IVMARRAY("PROC")=0  ; count of patients processed

 S IVMARRAY("EXTRACT")=0  ; count of patients extracted

 S IVMARRAY("TOTAL")=$P($G(^DPT(0)),"^",4)  ; total patients to check

 S XPDIDTOT=IVMARRAY("TOTAL")  ; total patients for status bar

 S IVMARRAY("UPDATE%")=5  ; init % for status bar update

 ;

 ; retrieve checkpoint parameter value to init DFN, previous run

 S DFN=+$$PARCP^XPDUTL("DFN")

 ;

 ; loop thru patients in PATIENT (#2) file

 F  S DFN=$O(^DPT(DFN)) Q:'DFN  D

 .;

 .; - update checkpoint parameter DFN

 .S %=$$UPCP^XPDUTL("DFN",DFN)

 .;

 .S IVMARRAY("PROC")=IVMARRAY("PROC")+1

 .;

 .; - update status bar during post-install if not queued

 .I '$D(ZTQUEUED) D

 ..S IVMARRAY("COMP%")=IVMARRAY("PROC")*100/IVMARRAY("TOTAL")  ; % complete

 ..I IVMARRAY("COMP%")>IVMARRAY("UPDATE%") D

 ...D UPDATE^XPDID(IVMARRAY("PROC"))

 ...S IVMARRAY("UPDATE%")=IVMARRAY("UPDATE%")+5  ; increase update %

 .;

 .; - quit if patient does not pass 1/98 bulk extract criteria

 .Q:'$$CRITERIA^IVMBULK1(DFN,BEGDT,ENDDT)

 .;

 .; - quit if patient does not pass current selection criteria

 .Q:'$$SELECT(DFN)

 .;

 .; - log patient for transmission in IVM PATIENT file

 .N EVENTS

 .S EVENTS("ENROLL")=1

 .I $$LOG^IVMPLOG(DFN,$$YEAR^IVMPLOG(DFN),.EVENTS) S IVMARRAY("EXTRACT")=IVMARRAY("EXTRACT")+1

 .;

 ;

 S IVMARRAY("STOP")=$$NOW^XLFDT  ; current date/time stopped

 Q

 ;

 ;

SELECT(DFN) ; Description: This function will determine if the patient meets the following extract selection criteria:

 ;

 ;   [Patient has SERVICE CONNECTED PERCENTAGE=0]

 ;            OR

 ;   [Patient has Other Entitled Eligibilities]

 ;

 ;  Input:

 ;   DFN - as ien of record in PATIENT (#2) file

 ;

 ; Output:

 ;   Function Value - Return 1 if patient meets the selection criteria, otherwise 0 is returned

 ;

 N SELECT S SELECT=0

 ;

 ; does the patient have an SC %=0?

 I $$SCZERO(DFN) S SELECT=1 G SELECTQ

 ;

 ; does patient have other entitled eligibilities?

 I $$OTHELIG(DFN) S SELECT=1

 ;

SELECTQ Q SELECT

 ;

 ;

SCZERO(DFN) ; Description: Used to determine if a patient has a SERVICE CONNECTED PERCENTAGE equal to zero.

 ;

 ;  Input:

 ;   DFN - as ien of record in PATIENT (#2) file

 ;

 ; Output:

 ;   Function Value - Return 1 if patient has a SERVICE CONNECTED PERCENTAGE equal to zero, otherwise return 0

 ;

 N SCZERO S SCZERO=0

 ;

 I $G(DFN),$D(^DPT(DFN,0)) D

 .I $P($G(^DPT(DFN,.3)),"^",2)=0 S SCZERO=1

 ;

 Q SCZERO

 ;

 ;

OTHELIG(DFN) ; Description: Used to determine if a patient has OTHER ENTITLED ELIGIBILITIES.

 ;

 ;  Input:

 ;   DFN - as ien of record in PATIENT (#2) file

 ;

 ; Output:

 ;   Function Value - return 1 if patient has other entitled eligibilities, otherwise return 0

 ;

 N OTH,OTHELIG,PRIME

 S (OTHELIG,OTH)=0

 ;

 I $G(DFN),$D(^DPT(DFN,0)) S PRIME=+$G(^DPT(DFN,.36))

 ;

 ; if Primary Eligibility, check for Other Entitled Eligibilities

 I $G(PRIME) D

 .F  S OTHELIG=$O(^DPT(DFN,"E",OTHELIG)) Q:'OTHELIG!(OTH=1)  D

 ..I OTHELIG'=PRIME S OTH=1

 ;

 Q OTH

 ;

 ;

BULL(IVMARRAY) ; Description: This function will generate a MailMan message contianing the extract results.

 ;

 ;  Input:

 ;   IVMARRAY - as local array containing extract results

 ;

 ; Output: None

 ;

 K XMZ

 N IVMTXT,IVMSITE,XMTEXT,XMSUB,XMDUZ,XMY

 N DIFROM  ; must new DIFROM when calling MailMan

 ;

 ; init variables

 S IVMSITE=$$SITE^VASITE

 S XMSUB="Patch IVM*2*19 Extract Results "_"("_$P(IVMSITE,"^",3)_")"

 S XMDUZ=.5

 S XMY(DUZ)="",XMY(.5)="",XMY("G.ENROLLMENT EXTRACT@IVM.DOMAIN.EXT")=""

 S XMTEXT="IVMTXT("

 ;

 S IVMTXT(1)="    > > > >  Patch IVM*2*19 Extract Results  < < < <"

 S IVMTXT(2)=""

 S IVMTXT(3)="               Facility Name:  "_$P(IVMSITE,"^",2)

 S IVMTXT(4)="              Station Number:  "_$P(IVMSITE,"^",3)

 S IVMTXT(5)=""

 S IVMTXT(6)="   Date/Time extract started:  "_$$FMTE^XLFDT(IVMARRAY("START"),"1P")

 S IVMTXT(7)="   Date/Time extract stopped:  "_$$FMTE^XLFDT(IVMARRAY("STOP"),"1P")

 S IVMTXT(8)=""

 S IVMTXT(9)="    Total patients processed:  "_IVMARRAY("PROC")

 S IVMTXT(10)="    Total patients extracted:  "_IVMARRAY("EXTRACT")

 S IVMTXT(11)="        Percentage extracted:  "_$S($G(IVMARRAY("PROC")):$P(IVMARRAY("EXTRACT")/IVMARRAY("PROC")*100,".")_"%",1:"")

 S IVMTXT(12)=""

 S IVMTXT(13)="  The "_IVMARRAY("EXTRACT")_" patients extracted will be included in the next daily"

 S IVMTXT(14)="  transmission(s) to the Health Eligibility Center (HEC)."

 ;

 D ^XMD

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---IVM20P19   6181     printed  Mar 13, 2025@21:04:44                                                                                                                                                                                                    Page 2

IVM20P19  ;ALB/KCL - Post-Install Extract ; 1-SEP-1998

 +1       ;;2.0;INCOME VERIFICATION MATCH;**19**; 21-OCT-94

 +2       ;

 +3       ;

POST      ; Entry point for post-install, setup check points

 +1        NEW %

 +2        SET %=$$NEWCP^XPDUTL("DFN","EN^IVM20P19",0)

 +3        QUIT 

 +4       ;

 +5       ;

EN        ; Description: This entry point will be the driver for the extract.

 +1       ;

 +2       ;  Input: None

 +3       ; Output: None

 +4       ;

 +5        NEW IVMARRAY,IVMBEGDT,IVMENDDT

 +6       ;

 +7       ; init variables (start/end date for search)

 +8        SET IVMBEGDT=2961001

 +9        SET IVMENDDT=DT

 +10      ;

 +11      ; perform extract, display results during post-install

 +12       DO BMES^XPDUTL("  Examining the PATIENT #2 file...")

 +13       DO EXTRACT(IVMBEGDT,IVMENDDT,.IVMARRAY)

 +14      ;

 +15       DO MES^XPDUTL("    Total patients processed: "_IVMARRAY("PROC"))

 +16       DO MES^XPDUTL("    Total patients extracted: "_IVMARRAY("EXTRACT"))

 +17       DO MES^XPDUTL("        Percentage extracted: "_$SELECT($GET(IVMARRAY("PROC")):$PIECE(IVMARRAY("EXTRACT")/IVMARRAY("PROC")*100,".")_"%",1:""))

 +18       DO MES^XPDUTL("")

 +19       DO MES^XPDUTL("  The "_IVMARRAY("EXTRACT")_" patients extracted will be included in the next daily")

 +20       DO MES^XPDUTL("  transmission(s) to the Health Eligibility Center (HEC).")

 +21      ;

 +22      ; send extract results bulletin

 +23       DO BMES^XPDUTL("  Sending extract results bulletin...")

 +24       DO BULL(.IVMARRAY)

 +25       QUIT 

 +26      ;

 +27      ;

EXTRACT(BEGDT,ENDDT,IVMARRAY) ; Description: Used to perform the extract and log patients in the IVM PATIENT file for transmission if selected.

 +1       ;

 +2       ;  Input:

 +3       ;   BEGDT - as begin date for extract search

 +4       ;   ENDDT - as end date for extract search

 +5       ;

 +6       ; Output:

 +7       ;   IVMARRAY - as local array containing extract results, pass by reference

 +8       ;

 +9        NEW DFN

 +10      ;

 +11      ; init varibles

 +12       KILL IVMARRAY

           SET IVMARRAY=""

 +13      ; current date/time started

           SET IVMARRAY("START")=$$NOW^XLFDT

 +14      ; count of patients processed

           SET IVMARRAY("PROC")=0

 +15      ; count of patients extracted

           SET IVMARRAY("EXTRACT")=0

 +16      ; total patients to check

           SET IVMARRAY("TOTAL")=$PIECE($GET(^DPT(0)),"^",4)

 +17      ; total patients for status bar

           SET XPDIDTOT=IVMARRAY("TOTAL")

 +18      ; init % for status bar update

           SET IVMARRAY("UPDATE%")=5

 +19      ;

 +20      ; retrieve checkpoint parameter value to init DFN, previous run

 +21       SET DFN=+$$PARCP^XPDUTL("DFN")

 +22      ;

 +23      ; loop thru patients in PATIENT (#2) file

 +24       FOR 

               SET DFN=$ORDER(^DPT(DFN))

               if 'DFN

                   QUIT 

               Begin DoDot:1

 +25      ;

 +26      ; - update checkpoint parameter DFN

 +27               SET %=$$UPCP^XPDUTL("DFN",DFN)

 +28      ;

 +29               SET IVMARRAY("PROC")=IVMARRAY("PROC")+1

 +30      ;

 +31      ; - update status bar during post-install if not queued

 +32               IF '$DATA(ZTQUEUED)

                       Begin DoDot:2

 +33      ; % complete

                           SET IVMARRAY("COMP%")=IVMARRAY("PROC")*100/IVMARRAY("TOTAL")

 +34                       IF IVMARRAY("COMP%")>IVMARRAY("UPDATE%")

                               Begin DoDot:3

 +35                               DO UPDATE^XPDID(IVMARRAY("PROC"))

 +36      ; increase update %

                                   SET IVMARRAY("UPDATE%")=IVMARRAY("UPDATE%")+5

                               End DoDot:3

                       End DoDot:2

 +37      ;

 +38      ; - quit if patient does not pass 1/98 bulk extract criteria

 +39               if '$$CRITERIA^IVMBULK1(DFN,BEGDT,ENDDT)

                       QUIT 

 +40      ;

 +41      ; - quit if patient does not pass current selection criteria

 +42               if '$$SELECT(DFN)

                       QUIT 

 +43      ;

 +44      ; - log patient for transmission in IVM PATIENT file

 +45               NEW EVENTS

 +46               SET EVENTS("ENROLL")=1

 +47               IF $$LOG^IVMPLOG(DFN,$$YEAR^IVMPLOG(DFN),.EVENTS)

                       SET IVMARRAY("EXTRACT")=IVMARRAY("EXTRACT")+1

 +48      ;

               End DoDot:1

 +49      ;

 +50      ; current date/time stopped

           SET IVMARRAY("STOP")=$$NOW^XLFDT

 +51       QUIT 

 +52      ;

 +53      ;

SELECT(DFN) ; Description: This function will determine if the patient meets the following extract selection criteria:

 +1       ;

 +2       ;   [Patient has SERVICE CONNECTED PERCENTAGE=0]

 +3       ;            OR

 +4       ;   [Patient has Other Entitled Eligibilities]

 +5       ;

 +6       ;  Input:

 +7       ;   DFN - as ien of record in PATIENT (#2) file

 +8       ;

 +9       ; Output:

 +10      ;   Function Value - Return 1 if patient meets the selection criteria, otherwise 0 is returned

 +11      ;

 +12       NEW SELECT

           SET SELECT=0

 +13      ;

 +14      ; does the patient have an SC %=0?

 +15       IF $$SCZERO(DFN)

               SET SELECT=1

               GOTO SELECTQ

 +16      ;

 +17      ; does patient have other entitled eligibilities?

 +18       IF $$OTHELIG(DFN)

               SET SELECT=1

 +19      ;

SELECTQ    QUIT SELECT

 +1       ;

 +2       ;

SCZERO(DFN) ; Description: Used to determine if a patient has a SERVICE CONNECTED PERCENTAGE equal to zero.

 +1       ;

 +2       ;  Input:

 +3       ;   DFN - as ien of record in PATIENT (#2) file

 +4       ;

 +5       ; Output:

 +6       ;   Function Value - Return 1 if patient has a SERVICE CONNECTED PERCENTAGE equal to zero, otherwise return 0

 +7       ;

 +8        NEW SCZERO

           SET SCZERO=0

 +9       ;

 +10       IF $GET(DFN)

               IF $DATA(^DPT(DFN,0))

                   Begin DoDot:1

 +11                   IF $PIECE($GET(^DPT(DFN,.3)),"^",2)=0

                           SET SCZERO=1

                   End DoDot:1

 +12      ;

 +13       QUIT SCZERO

 +14      ;

 +15      ;

OTHELIG(DFN) ; Description: Used to determine if a patient has OTHER ENTITLED ELIGIBILITIES.

 +1       ;

 +2       ;  Input:

 +3       ;   DFN - as ien of record in PATIENT (#2) file

 +4       ;

 +5       ; Output:

 +6       ;   Function Value - return 1 if patient has other entitled eligibilities, otherwise return 0

 +7       ;

 +8        NEW OTH,OTHELIG,PRIME

 +9        SET (OTHELIG,OTH)=0

 +10      ;

 +11       IF $GET(DFN)

               IF $DATA(^DPT(DFN,0))

                   SET PRIME=+$GET(^DPT(DFN,.36))

 +12      ;

 +13      ; if Primary Eligibility, check for Other Entitled Eligibilities

 +14       IF $GET(PRIME)

               Begin DoDot:1

 +15               FOR 

                       SET OTHELIG=$ORDER(^DPT(DFN,"E",OTHELIG))

                       if 'OTHELIG!(OTH=1)

                           QUIT 

                       Begin DoDot:2

 +16                       IF OTHELIG'=PRIME

                               SET OTH=1

                       End DoDot:2

               End DoDot:1

 +17      ;

 +18       QUIT OTH

 +19      ;

 +20      ;

BULL(IVMARRAY) ; Description: This function will generate a MailMan message contianing the extract results.

 +1       ;

 +2       ;  Input:

 +3       ;   IVMARRAY - as local array containing extract results

 +4       ;

 +5       ; Output: None

 +6       ;

 +7        KILL XMZ

 +8        NEW IVMTXT,IVMSITE,XMTEXT,XMSUB,XMDUZ,XMY

 +9       ; must new DIFROM when calling MailMan

           NEW DIFROM

 +10      ;

 +11      ; init variables

 +12       SET IVMSITE=$$SITE^VASITE

 +13       SET XMSUB="Patch IVM*2*19 Extract Results "_"("_$PIECE(IVMSITE,"^",3)_")"

 +14       SET XMDUZ=.5

 +15       SET XMY(DUZ)=""

           SET XMY(.5)=""

           SET XMY("G.ENROLLMENT EXTRACT@IVM.DOMAIN.EXT")=""

 +16       SET XMTEXT="IVMTXT("

 +17      ;

 +18       SET IVMTXT(1)="    > > > >  Patch IVM*2*19 Extract Results  < < < <"

 +19       SET IVMTXT(2)=""

 +20       SET IVMTXT(3)="               Facility Name:  "_$PIECE(IVMSITE,"^",2)

 +21       SET IVMTXT(4)="              Station Number:  "_$PIECE(IVMSITE,"^",3)

 +22       SET IVMTXT(5)=""

 +23       SET IVMTXT(6)="   Date/Time extract started:  "_$$FMTE^XLFDT(IVMARRAY("START"),"1P")

 +24       SET IVMTXT(7)="   Date/Time extract stopped:  "_$$FMTE^XLFDT(IVMARRAY("STOP"),"1P")

 +25       SET IVMTXT(8)=""

 +26       SET IVMTXT(9)="    Total patients processed:  "_IVMARRAY("PROC")

 +27       SET IVMTXT(10)="    Total patients extracted:  "_IVMARRAY("EXTRACT")

 +28       SET IVMTXT(11)="        Percentage extracted:  "_$SELECT($GET(IVMARRAY("PROC")):$PIECE(IVMARRAY("EXTRACT")/IVMARRAY("PROC")*100,".")_"%",1:"")

 +29       SET IVMTXT(12)=""

 +30       SET IVMTXT(13)="  The "_IVMARRAY("EXTRACT")_" patients extracted will be included in the next daily"

 +31       SET IVMTXT(14)="  transmission(s) to the Health Eligibility Center (HEC)."

 +32      ;

 +33       DO ^XMD

 +34       QUIT