QANPEDT.m

QANPEDT ;HISC/GJC-EDIT OF A PATIENT ON THE NQADB ;7/12/93  09:42

 ;;2.0;Incident Reporting;**20**;08/07/1992

 ;

 ;*** Required Variables ***

 ;QA1 --------> New patient name

 ;QAHDNM -----> Old patient name

 ;QAHDSSN ----> Old patient SSN

 ;QANIEN -----> IEN of file 742.4

 ;QANSSN -----> New patient SSN

 ;*** Required Variables ***

 N QANCASE,QANINCD,QANDATE,QAN7424 K ^UTILITY($J,"QAN MAIL")

 ; Set up string of data

 S QAN7424=$G(^QA(742.4,QANIEN,0)),QANZER0=$G(^QA(740,1,0))

 S QANSERV=$P(QANZER0,U,4),QANDOM=$P(QANZER0,U,5)

 S QANCASE=$P(QAN7424,U),QANINCD=$P(QAN7424,U,2),QANDATE=$P(QAN7424,U,3)

 S QANINCD=$P($G(^QA(742.1,QANINCD,0)),U)

 S QANINCD=$TR(QANINCD,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")

 S ^UTILITY($J,"QAN MAIL",1)="^^PEDIT^"_$G(QANCASE)_"^"_$G(QANINCD)_"^"_$G(QANDATE)_"^"_$G(QAHDNM)_"^"_$G(QAHDSSN)_"^"_$G(QA1)_"^"_$G(QANSSN)_"^"_$G(QANADMDT)_"^"_$G(QANDOB)_"^"

 D BULL^QANFULL0 ;Fire off the message.

EXIT ;

 K QANDOM,QANZER0,QANSERV

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---QANPEDT   1003     printed  Apr 09, 2024@21:01:31                                                                                                                                                                                                     Page 2

QANPEDT   ;HISC/GJC-EDIT OF A PATIENT ON THE NQADB ;7/12/93  09:42

 +1       ;;2.0;Incident Reporting;**20**;08/07/1992

 +2       ;

 +3       ;*** Required Variables ***

 +4       ;QA1 --------> New patient name

 +5       ;QAHDNM -----> Old patient name

 +6       ;QAHDSSN ----> Old patient SSN

 +7       ;QANIEN -----> IEN of file 742.4

 +8       ;QANSSN -----> New patient SSN

 +9       ;*** Required Variables ***

 +10       NEW QANCASE,QANINCD,QANDATE,QAN7424

           KILL ^UTILITY($JOB,"QAN MAIL")

 +11      ; Set up string of data

 +12       SET QAN7424=$GET(^QA(742.4,QANIEN,0))

           SET QANZER0=$GET(^QA(740,1,0))

 +13       SET QANSERV=$PIECE(QANZER0,U,4)

           SET QANDOM=$PIECE(QANZER0,U,5)

 +14       SET QANCASE=$PIECE(QAN7424,U)

           SET QANINCD=$PIECE(QAN7424,U,2)

           SET QANDATE=$PIECE(QAN7424,U,3)

 +15       SET QANINCD=$PIECE($GET(^QA(742.1,QANINCD,0)),U)

 +16       SET QANINCD=$TRANSLATE(QANINCD,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")

 +17       SET ^UTILITY($JOB,"QAN MAIL",1)="^^PEDIT^"_$GET(QANCASE)_"^"_$GET(QANINCD)_"^"_$GET(QANDATE)_"^"_$GET(QAHDNM)_"^"_$GET(QAHDSSN)_"^"_$GET(QA1)_"^"_$GET(QANSSN)_"^"_$GET(QANADMDT)_"^"_$GET(QANDOB)_"^"

 +18      ;Fire off the message.

           DO BULL^QANFULL0

EXIT      ;

 +1        KILL QANDOM,QANZER0,QANSERV

 +2        QUIT