IVM273M ;ALB/PDJ IVM*2.0*73 - CLEANUP IVM PATIENT FILE;02/07/2003
;;2.0;INCOME VERIFICATION MATCH;**73**; 21-OCT-94
;
; A mail message will be sent to the user when the edit process
; is complete.
;
;
MAIL ; Send a mailman msg to user with results
N DIFROM,%
N DATA,NODE,TEXT,XMDUZ,XMSUB,XMTEXT,XMY,Y
N XTPAT,NAME
N PIEN,R3015,SSN
S XTPAT="IVM*2.0*73-PATREC"
K ^TMP("IVM2073",$J)
S XMSUB="IVM PATIENT file Cleanup"
S XMDUZ="IVM Edit Package",XMY(DUZ)="",XMY(.5)=""
S XMTEXT="^TMP(""IVM2073"",$J,"
D NOW^%DTC S Y=% D DD^%DT
S ^TMP("IVM2073",$J,1)="IVM PATIENT file cleanup"
S ^TMP("IVM2073",$J,2)=" "
S NODE=2
S NODE=NODE+1
S ^TMP("IVM2073",$J,NODE)=" "
;
PRTRECS ; Print List of records
S NODE=NODE+1
S ^TMP("IVM2073",$J,NODE)=" "
S TEXT=" Total IVM PATIENT Records Updated: "
S TEXT=$$BLDSTR($J(+$G(^XTMP(XTPAT,1)),8,0),TEXT,50,8)
S NODE=NODE+1
S ^TMP("IVM2073",$J,NODE)=TEXT
S NODE=NODE+1
S ^TMP("IVM2073",$J,NODE)=" "
S NODE=NODE+1
S ^TMP("IVM2073",$J,NODE)=" "
;
S TEXT=" "
S TEXT=$$BLDSTR("DFN",TEXT,3,3)
S TEXT=$$BLDSTR("301.5",TEXT,16,5)
S TEXT=$$BLDSTR("SSN",TEXT,29,3)
S TEXT=$$BLDSTR("Name",TEXT,43,4)
S TEXT=$$BLDSTR("Addr?",TEXT,67,5)
S TEXT=$$BLDSTR("Ph?",TEXT,75,3)
S NODE=NODE+1
S ^TMP("IVM2073",$J,NODE)=TEXT
S NODE=NODE+1
S ^TMP("IVM2073",$J,NODE)=$$REPEAT^XLFSTR("=",79)
S PIEN=""
F S PIEN=$O(^XTMP(XTPAT,"RECS",PIEN)) Q:PIEN="" D
. D BLDPAT
S NODE=NODE+1
S ^TMP("IVM2073",$J,NODE)=$$REPEAT^XLFSTR("=",79)
;
MAIL1 ; Send message
S NODE=NODE+1
S ^TMP("IVM2073",$J,NODE)=" "
S NODE=NODE+1
S ^TMP("IVM2073",$J,NODE)=" ******** END OF MESSAGE ********"
;
D ^XMD
K ^TMP("IVM2073",$J)
Q
;
BLDPAT ; Format Patient line for printing
N DATA,NAME,PH,AD
S DATA=^XTMP(XTPAT,"RECS",PIEN)
S R3015=$P(DATA,"^",1),NAME=$P(DATA,"^",2),SSN=$P(DATA,"^",3)
S AD=$P(DATA,"^",4),PH=$P(DATA,"^",5)
S TEXT=" "
S TEXT=$$BLDSTR(PIEN,TEXT,3,$L(PIEN))
S TEXT=$$BLDSTR(R3015,TEXT,16,$L(R3015))
S TEXT=$$BLDSTR(SSN,TEXT,29,$L(SSN))
S TEXT=$$BLDSTR($E(NAME,1,20),TEXT,43,20)
I AD S TEXT=$$BLDSTR("YES",TEXT,68,3)
I PH S TEXT=$$BLDSTR("YES",TEXT,75,3)
S NODE=NODE+1
S ^TMP("IVM2073",$J,NODE)=TEXT
Q
;
BLDSTR(NSTR,STR,COL,NSL) ; build a string
; Input:
; NSTR = a string to be added to STR
; STR = an existing string to which NSTR will be added
; COL = column location at which NSTR will be added to STR
; NSL = length of new string
; Output:
; returns STR with NSTR appended at the specified COL
;
Q $E(STR_$J("",COL-1),1,COL-1)_$E(NSTR_$J("",NSL),1,NSL)_$E(STR,COL+NSL,999)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVM273M 2654 printed Oct 16, 2024@18:01:42 Page 2
IVM273M ;ALB/PDJ IVM*2.0*73 - CLEANUP IVM PATIENT FILE;02/07/2003
+1 ;;2.0;INCOME VERIFICATION MATCH;**73**; 21-OCT-94
+2 ;
+3 ; A mail message will be sent to the user when the edit process
+4 ; is complete.
+5 ;
+6 ;
MAIL ; Send a mailman msg to user with results
+1 NEW DIFROM,%
+2 NEW DATA,NODE,TEXT,XMDUZ,XMSUB,XMTEXT,XMY,Y
+3 NEW XTPAT,NAME
+4 NEW PIEN,R3015,SSN
+5 SET XTPAT="IVM*2.0*73-PATREC"
+6 KILL ^TMP("IVM2073",$JOB)
+7 SET XMSUB="IVM PATIENT file Cleanup"
+8 SET XMDUZ="IVM Edit Package"
SET XMY(DUZ)=""
SET XMY(.5)=""
+9 SET XMTEXT="^TMP(""IVM2073"",$J,"
+10 DO NOW^%DTC
SET Y=%
DO DD^%DT
+11 SET ^TMP("IVM2073",$JOB,1)="IVM PATIENT file cleanup"
+12 SET ^TMP("IVM2073",$JOB,2)=" "
+13 SET NODE=2
+14 SET NODE=NODE+1
+15 SET ^TMP("IVM2073",$JOB,NODE)=" "
+16 ;
PRTRECS ; Print List of records
+1 SET NODE=NODE+1
+2 SET ^TMP("IVM2073",$JOB,NODE)=" "
+3 SET TEXT=" Total IVM PATIENT Records Updated: "
+4 SET TEXT=$$BLDSTR($JUSTIFY(+$GET(^XTMP(XTPAT,1)),8,0),TEXT,50,8)
+5 SET NODE=NODE+1
+6 SET ^TMP("IVM2073",$JOB,NODE)=TEXT
+7 SET NODE=NODE+1
+8 SET ^TMP("IVM2073",$JOB,NODE)=" "
+9 SET NODE=NODE+1
+10 SET ^TMP("IVM2073",$JOB,NODE)=" "
+11 ;
+12 SET TEXT=" "
+13 SET TEXT=$$BLDSTR("DFN",TEXT,3,3)
+14 SET TEXT=$$BLDSTR("301.5",TEXT,16,5)
+15 SET TEXT=$$BLDSTR("SSN",TEXT,29,3)
+16 SET TEXT=$$BLDSTR("Name",TEXT,43,4)
+17 SET TEXT=$$BLDSTR("Addr?",TEXT,67,5)
+18 SET TEXT=$$BLDSTR("Ph?",TEXT,75,3)
+19 SET NODE=NODE+1
+20 SET ^TMP("IVM2073",$JOB,NODE)=TEXT
+21 SET NODE=NODE+1
+22 SET ^TMP("IVM2073",$JOB,NODE)=$$REPEAT^XLFSTR("=",79)
+23 SET PIEN=""
+24 FOR
SET PIEN=$ORDER(^XTMP(XTPAT,"RECS",PIEN))
if PIEN=""
QUIT
Begin DoDot:1
+25 DO BLDPAT
End DoDot:1
+26 SET NODE=NODE+1
+27 SET ^TMP("IVM2073",$JOB,NODE)=$$REPEAT^XLFSTR("=",79)
+28 ;
MAIL1 ; Send message
+1 SET NODE=NODE+1
+2 SET ^TMP("IVM2073",$JOB,NODE)=" "
+3 SET NODE=NODE+1
+4 SET ^TMP("IVM2073",$JOB,NODE)=" ******** END OF MESSAGE ********"
+5 ;
+6 DO ^XMD
+7 KILL ^TMP("IVM2073",$JOB)
+8 QUIT
+9 ;
BLDPAT ; Format Patient line for printing
+1 NEW DATA,NAME,PH,AD
+2 SET DATA=^XTMP(XTPAT,"RECS",PIEN)
+3 SET R3015=$PIECE(DATA,"^",1)
SET NAME=$PIECE(DATA,"^",2)
SET SSN=$PIECE(DATA,"^",3)
+4 SET AD=$PIECE(DATA,"^",4)
SET PH=$PIECE(DATA,"^",5)
+5 SET TEXT=" "
+6 SET TEXT=$$BLDSTR(PIEN,TEXT,3,$LENGTH(PIEN))
+7 SET TEXT=$$BLDSTR(R3015,TEXT,16,$LENGTH(R3015))
+8 SET TEXT=$$BLDSTR(SSN,TEXT,29,$LENGTH(SSN))
+9 SET TEXT=$$BLDSTR($EXTRACT(NAME,1,20),TEXT,43,20)
+10 IF AD
SET TEXT=$$BLDSTR("YES",TEXT,68,3)
+11 IF PH
SET TEXT=$$BLDSTR("YES",TEXT,75,3)
+12 SET NODE=NODE+1
+13 SET ^TMP("IVM2073",$JOB,NODE)=TEXT
+14 QUIT
+15 ;
BLDSTR(NSTR,STR,COL,NSL) ; build a string
+1 ; Input:
+2 ; NSTR = a string to be added to STR
+3 ; STR = an existing string to which NSTR will be added
+4 ; COL = column location at which NSTR will be added to STR
+5 ; NSL = length of new string
+6 ; Output:
+7 ; returns STR with NSTR appended at the specified COL
+8 ;
+9 QUIT $EXTRACT(STR_$JUSTIFY("",COL-1),1,COL-1)_$EXTRACT(NSTR_$JUSTIFY("",NSL),1,NSL)_$EXTRACT(STR,COL+NSL,999)
