ORY244 ;SLC/JEH -- post-install for OR*3*244 ;12/14/2005
;;3.0;ORDER ENTRY/RESULTS REPORTING;**244**;Dec 17, 1997;Build 1
; Variables used:
; DATE = the date 2nd part of the sub script of LRO(69,DATE
; LORSN = the multiple counter of 69 or 4th part to get to each LAB ORDER
; LABDFN = DFN of LR file
; TSTCNT = the sub multiple / counter of the lab test or the 6th part of the 69 sub script
; OERRDFN = DFN of OR(100
; LRSUB = sub of LAB(60, the lab test in LR
; L60DFN = DFN of Lab test performed
; TSTCNT = 6th part of sub script of LOR(69, pts to LAB TEST( LAB(60, and corresponding OR DFN
; TSTTYP= CH MI AP, from the order file OR(100
; PANEL=1 Indicates from a panel test versies single test PANEL=""
; CNT244 = Number of Abnormal results modified
;
;
POST ; -- Postinit corrects the abnormal flag and resuslts set in the OR(100, file
N DATE,LOCATION,PTNAME,LABDFN,LORSN,LRSUB,TSTCNT,PANEL,TSTTYP,LRIVDAT,LSTEST,LABPNUM,TEST
N L60DFN,RCNT,LRRESULT,LV60TST,OERRDFN,OR0,ORESULTS,CNT244,DAT60LV1,DAT60LV2,DAT69LV1,DAT69LV2
S LOCATION="",PTNAME="",LABDFN="",PANEL="",CNT244=0,TEST=""
K ^TMP("ORFIX",$J),^TMP("ORTXT",$J)
S ^TMP("ORFIX",$J,0)=0
;
PTR69 ; -- Loop thru Lab order file 69 to find ptr to Order file (OR 100) and Lab Data file (LR
N ORMSG,ZTSK
S ORMSG(1)=""
S ORMSG(2)="STARTING reinstatement of missing abnormal results in the ORDER file #100"
S ORMSG(3)=""
D MES^XPDUTL(.ORMSG)
;W !,"STARTING reinstatement of missing abnormal results in the ORDER file #100"
S DATE=3050815 ; PROBLEM START WITH LR*5.2*340 given to test sites Aug 15
F S DATE=$O(^LRO(69,DATE)) Q:DATE'?7N!(DATE>3051231) D ;69 loop
. ;
. S LORSN=0
. F S LORSN=$O(^LRO(69,DATE,1,LORSN)) Q:LORSN'>0 D ;loop within LR order to get multi test
. . ;
. . S DAT69LV1=$G(^LRO(69,DATE,1,LORSN,0)) Q:DAT69LV1=""
. . S LABDFN=$P(^LRO(69,DATE,1,LORSN,0),"^",1) ;get LR DFN
. . I LABDFN="" Q ;No LR not need to process v2
. . ;
. . S TSTCNT=0
. . F S TSTCNT=$O(^LRO(69,DATE,1,LORSN,2,TSTCNT)) Q:TSTCNT=""!(TSTCNT]"@") D ;loop thru test
. . . ;
. . . W "."
. . . S DAT69LV2=$G(^LRO(69,DATE,1,LORSN,2,TSTCNT,0)) Q:DAT69LV2=""
. . . S OERRDFN=$P(^LRO(69,DATE,1,LORSN,2,TSTCNT,0),"^",7) ;get DFN of OR(100
. . . I OERRDFN="" Q ;No OR(100 no need to process v2
. . . S L60DFN=+$P(^LRO(69,DATE,1,LORSN,2,TSTCNT,0),"^",1) ;get DFN of 60 lab test performed
. . . I L60DFN="" Q ;No lab test no need to process v2
. . . ; If test is a Panel of test or a single test?
. . . S DAT60LV1=$G(^LAB(60,L60DFN,0)) Q:DAT60LV1=""
. . . S LSTEST=L60DFN
. . . S PANEL=""
. . . S PANEL=$G(^LAB(60,L60DFN,2,1,0)) ;if there, equal to 1st test in panel test.
. . . I PANEL'="" S PANEL=L60DFN
. . . ; OR100FU GET INFO FROM OR(100
. . . I $G(^OR(100,OERRDFN,7))="" Q ;No results no need to process
. . . I $P(^OR(100,OERRDFN,7),"^",2)=1 Q ;If abnomal results already, no need to process
. . . ;
. . . S LRIVDAT="",TSTTYP="",ORESULTS=""
. . . I $G(^OR(100,OERRDFN,4))="" Q ;If no date time of type quit v3
. . . S LRIVDAT=$P(^OR(100,OERRDFN,4),";",5)
. . . S TSTTYP=$P(^OR(100,OERRDFN,4),";",4)
. . . ;If not one of the Lab test types processed by LR7OR1 then quit
. . . I TSTTYP'="CH" Q
. . . I LRIVDAT="" Q ;No LR date no need to process v2
. . . I PANEL="" D NONPAN
. . . ;
. . . I PANEL'="" D PAN60 ; PROCESS A PANEL OF TEST FOR THSI ORDER.
;
D MAIL
;W !,"Up date of Order file is complete!"
;W !,"Please check your Mail for a list of modified ORDER files"
N ORMSG,ZTSK
S ORMSG(1)=""
S ORMSG(2)="Up date of Order file is complete!"
S ORMSG(3)="Please check your Mail for a list of modified ORDER files"
S ORMSG(4)=""
D MES^XPDUTL(.ORMSG)
Q
;
NONPAN ;
S DAT60LV2=$G(^LAB(60,L60DFN,.2)) Q:DAT60LV2=""
S LRSUB=$P(^LAB(60,L60DFN,.2),"^",1)
I LRSUB="" Q ; if not test skip v2
S LRRESULT=$G(^LR(LABDFN,TSTTYP,LRIVDAT,LRSUB)) Q:LRRESULT="" ;If no results quit
S TEST=$P(LRRESULT,"^",2)
I (TEST["L")!(TEST["H") D Q
. I $G(^LAB(60,L60DFN,.1))="" Q ;If no test name quit v3
. S ORESULTS=$P(^LAB(60,L60DFN,.1),"^",1)_"="_$P(LRRESULT,"^",1)
. D ORUPDAT ;set ABNORMAL results in Order file
Q
;
PAN60 ;
S ORESULTS="" ;Clear for the next order file
; S DAT60LV1=$G(^LAB(60,LRSUB,0)) Q:DAT60LV1=""
;
; Lab(60 DFN in LOR(69 was a Panel of test.
; If an abnormal test in the panel test loop thru the panel test to pull each individual test
; also loop Thru the LR from the start to pull the results to put with the test from LAB(60
S LRSUB=""
; Loop Thru LR file to pull individual test results when from a panel of test.
S RCNT=0
S LSTEST=""
S LABPNUM=0
F S LABPNUM=$O(^LAB(60,PANEL,2,LABPNUM)) Q:LABPNUM=""!(LABPNUM]"@") D
. S LV60TST=$G(^LAB(60,PANEL,2,LABPNUM,0)) Q:LV60TST=""
. S L60DFN=$P(LV60TST,"^",1)
. I L60DFN="" Q ;If not test skip v3
. S LRSUB=$G(^LAB(60,L60DFN,.2)) ; If L60DFN not null but not valid quit v3
. I LRSUB="" Q ; v3
. S LRSUB=$P(^LAB(60,L60DFN,.2),"^",1)
. S LRRESULT=$G(^LR(LABDFN,TSTTYP,LRIVDAT,LRSUB)) Q:LRRESULT="" ;If no test quit
. S TEST=$P(LRRESULT,"^",2) Q:LRRESULT="" ;If no results quit
. I (TEST["L")!(TEST["H") D Q
. . S RCNT=RCNT+1
. . S DAT60LV1=$G(^LAB(60,L60DFN,0)) Q:DAT60LV1=""
. . S LSTEST=LRSUB
. . I $G(^LAB(60,L60DFN,.1))="" Q ;If no test name quit v3
. . S $P(ORESULTS,",",RCNT)=$P(^LAB(60,L60DFN,.1),"^",1)_"="_$P(LRRESULT,"^",1)_" "
. . ; S LRSUB=LRSUB+1 ;Bump to the next LR test results
I ORESULTS'="" D ORUPDAT ;set ABNORMAL results in Order file
Q
;
ORUPDAT ; Update the OR(100, file Abnormal results
;
S CNT244=CNT244+1
S ^TMP("ORFIX",$J,0)=CNT244
S PTNAME=""
S OR0=$G(^OR(100,OERRDFN,0))
S PTNAME=$$PTNM($P(OR0,U,2))
S ^TMP("ORFIX",$J,CNT244)="PATIENT NAME="_PTNAME
S ^TMP("ORFIX",$J,CNT244,0)=" ORER FILE DFN="_OERRDFN
S ^TMP("ORFIX",$J,CNT244,1)=" LAB DATA LRDFN="_LABDFN
I PANEL="" S ^TMP("ORFIX",$J,CNT244,2)=" LABORATORY TEST IEN="_LSTEST
I PANEL'="" S ^TMP("ORFIX",$J,CNT244,2)=" LABORATORY TEST(PANEL) IEN="_PANEL
S ^TMP("ORFIX",$J,CNT244,3)=" ABNORMAL TEST RESULTS: "_ORESULTS
S $P(^OR(100,OERRDFN,7),"^",2)=1
S $P(^OR(100,OERRDFN,7),"^",3)=ORESULTS
;W !," ABNORMAL TEST RESULTS: ",ORESULTS
;
;S THISTEST=^OR(100,OERRDFN,7)
;W !,"Before update ^OR(100,"_OERRDFN_",7)=",THISTEST
;
;S THISTEST=^OR(100,OERRDFN,7)
;W !,"After update ^OR(100,"_OERRDFN_",7)=",THISTEST
;W !
Q
;
;
;
MAIL ;Send results of cleanup in a mail message to initiator
N I,XMSUB,XMTEXT,XMDUZ,XMY,DIFROM
S XMSUB="Patch OR*3*244 Clean up completed"
S XMDUZ="Patch OR*3*244 Clean up job"
S XMY(.5)="" S:$G(DUZ) XMY(DUZ)=""
S XMTEXT="^TMP(""ORTXT"",$J,"
K ^TMP("ORTXT",$J)
; set up header and count
S I=1
S ^TMP("ORTXT",$J,I)="The reinstatement of Abnormal results has completed.",I=I+1
S ^TMP("ORTXT",$J,I)="Below is a listing of Abnormal results taken from Lab test and added to the Order file.",I=I+1
S ^TMP("ORTXT",$J,I)="",I=I+1
S ^TMP("ORTXT",$J,I)=+$P($G(^TMP("ORFIX",$J,0)),U)_" orders had abnormal results added.",I=I+1
S ^TMP("ORTXT",$J,I)="",I=I+1
I $G(^TMP("ORFIX",$J,0))=0 S ^TMP("ORTXT",$J,I)="No changes were made to your database.",I=I+1
S ^TMP("ORTXT",$J,I)="",I=I+1
; set up message text
S CNT244=0 F S CNT244=$O(^TMP("ORFIX",$J,CNT244)) Q:CNT244="" D
.S ^TMP("ORTXT",$J,I)=^TMP("ORFIX",$J,CNT244),I=I+1
.S ^TMP("ORTXT",$J,I)=^TMP("ORFIX",$J,CNT244,0),I=I+1
.S ^TMP("ORTXT",$J,I)=^TMP("ORFIX",$J,CNT244,1),I=I+1
.S ^TMP("ORTXT",$J,I)=^TMP("ORFIX",$J,CNT244,2),I=I+1
.S ^TMP("ORTXT",$J,I)=^TMP("ORFIX",$J,CNT244,3),I=I+1
.S ^TMP("ORTXT",$J,I)="",I=I+1
D ^XMD ;send results
Q
;
PTNM(IEN) ;Return pt name or -1 if unable to determine
N DFN,VADM
I +IEN=0!(IEN'["DPT") Q -1
S DFN=+IEN
D ^VADPT
I $G(VADM(1))="" Q -1
Q $G(VADM(1))
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORY244 7918 printed Apr 09, 2024@21:30:07 Page 2
ORY244 ;SLC/JEH -- post-install for OR*3*244 ;12/14/2005
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**244**;Dec 17, 1997;Build 1
+2 ; Variables used:
+3 ; DATE = the date 2nd part of the sub script of LRO(69,DATE
+4 ; LORSN = the multiple counter of 69 or 4th part to get to each LAB ORDER
+5 ; LABDFN = DFN of LR file
+6 ; TSTCNT = the sub multiple / counter of the lab test or the 6th part of the 69 sub script
+7 ; OERRDFN = DFN of OR(100
+8 ; LRSUB = sub of LAB(60, the lab test in LR
+9 ; L60DFN = DFN of Lab test performed
+10 ; TSTCNT = 6th part of sub script of LOR(69, pts to LAB TEST( LAB(60, and corresponding OR DFN
+11 ; TSTTYP= CH MI AP, from the order file OR(100
+12 ; PANEL=1 Indicates from a panel test versies single test PANEL=""
+13 ; CNT244 = Number of Abnormal results modified
+14 ;
+15 ;
POST ; -- Postinit corrects the abnormal flag and resuslts set in the OR(100, file
+1 NEW DATE,LOCATION,PTNAME,LABDFN,LORSN,LRSUB,TSTCNT,PANEL,TSTTYP,LRIVDAT,LSTEST,LABPNUM,TEST
+2 NEW L60DFN,RCNT,LRRESULT,LV60TST,OERRDFN,OR0,ORESULTS,CNT244,DAT60LV1,DAT60LV2,DAT69LV1,DAT69LV2
+3 SET LOCATION=""
SET PTNAME=""
SET LABDFN=""
SET PANEL=""
SET CNT244=0
SET TEST=""
+4 KILL ^TMP("ORFIX",$JOB),^TMP("ORTXT",$JOB)
+5 SET ^TMP("ORFIX",$JOB,0)=0
+6 ;
PTR69 ; -- Loop thru Lab order file 69 to find ptr to Order file (OR 100) and Lab Data file (LR
+1 NEW ORMSG,ZTSK
+2 SET ORMSG(1)=""
+3 SET ORMSG(2)="STARTING reinstatement of missing abnormal results in the ORDER file #100"
+4 SET ORMSG(3)=""
+5 DO MES^XPDUTL(.ORMSG)
+6 ;W !,"STARTING reinstatement of missing abnormal results in the ORDER file #100"
+7 ; PROBLEM START WITH LR*5.2*340 given to test sites Aug 15
SET DATE=3050815
+8 ;69 loop
FOR
SET DATE=$ORDER(^LRO(69,DATE))
if DATE'?7N!(DATE>3051231)
QUIT
Begin DoDot:1
+9 ;
+10 SET LORSN=0
+11 ;loop within LR order to get multi test
FOR
SET LORSN=$ORDER(^LRO(69,DATE,1,LORSN))
if LORSN'>0
QUIT
Begin DoDot:2
+12 ;
+13 SET DAT69LV1=$GET(^LRO(69,DATE,1,LORSN,0))
if DAT69LV1=""
QUIT
+14 ;get LR DFN
SET LABDFN=$PIECE(^LRO(69,DATE,1,LORSN,0),"^",1)
+15 ;No LR not need to process v2
IF LABDFN=""
QUIT
+16 ;
+17 SET TSTCNT=0
+18 ;loop thru test
FOR
SET TSTCNT=$ORDER(^LRO(69,DATE,1,LORSN,2,TSTCNT))
if TSTCNT=""!(TSTCNT]"@")
QUIT
Begin DoDot:3
+19 ;
+20 WRITE "."
+21 SET DAT69LV2=$GET(^LRO(69,DATE,1,LORSN,2,TSTCNT,0))
if DAT69LV2=""
QUIT
+22 ;get DFN of OR(100
SET OERRDFN=$PIECE(^LRO(69,DATE,1,LORSN,2,TSTCNT,0),"^",7)
+23 ;No OR(100 no need to process v2
IF OERRDFN=""
QUIT
+24 ;get DFN of 60 lab test performed
SET L60DFN=+$PIECE(^LRO(69,DATE,1,LORSN,2,TSTCNT,0),"^",1)
+25 ;No lab test no need to process v2
IF L60DFN=""
QUIT
+26 ; If test is a Panel of test or a single test?
+27 SET DAT60LV1=$GET(^LAB(60,L60DFN,0))
if DAT60LV1=""
QUIT
+28 SET LSTEST=L60DFN
+29 SET PANEL=""
+30 ;if there, equal to 1st test in panel test.
SET PANEL=$GET(^LAB(60,L60DFN,2,1,0))
+31 IF PANEL'=""
SET PANEL=L60DFN
+32 ; OR100FU GET INFO FROM OR(100
+33 ;No results no need to process
IF $GET(^OR(100,OERRDFN,7))=""
QUIT
+34 ;If abnomal results already, no need to process
IF $PIECE(^OR(100,OERRDFN,7),"^",2)=1
QUIT
+35 ;
+36 SET LRIVDAT=""
SET TSTTYP=""
SET ORESULTS=""
+37 ;If no date time of type quit v3
IF $GET(^OR(100,OERRDFN,4))=""
QUIT
+38 SET LRIVDAT=$PIECE(^OR(100,OERRDFN,4),";",5)
+39 SET TSTTYP=$PIECE(^OR(100,OERRDFN,4),";",4)
+40 ;If not one of the Lab test types processed by LR7OR1 then quit
+41 IF TSTTYP'="CH"
QUIT
+42 ;No LR date no need to process v2
IF LRIVDAT=""
QUIT
+43 IF PANEL=""
DO NONPAN
+44 ;
+45 ; PROCESS A PANEL OF TEST FOR THSI ORDER.
IF PANEL'=""
DO PAN60
End DoDot:3
End DoDot:2
End DoDot:1
+46 ;
+47 DO MAIL
+48 ;W !,"Up date of Order file is complete!"
+49 ;W !,"Please check your Mail for a list of modified ORDER files"
+50 NEW ORMSG,ZTSK
+51 SET ORMSG(1)=""
+52 SET ORMSG(2)="Up date of Order file is complete!"
+53 SET ORMSG(3)="Please check your Mail for a list of modified ORDER files"
+54 SET ORMSG(4)=""
+55 DO MES^XPDUTL(.ORMSG)
+56 QUIT
+57 ;
NONPAN ;
+1 SET DAT60LV2=$GET(^LAB(60,L60DFN,.2))
if DAT60LV2=""
QUIT
+2 SET LRSUB=$PIECE(^LAB(60,L60DFN,.2),"^",1)
+3 ; if not test skip v2
IF LRSUB=""
QUIT
+4 ;If no results quit
SET LRRESULT=$GET(^LR(LABDFN,TSTTYP,LRIVDAT,LRSUB))
if LRRESULT=""
QUIT
+5 SET TEST=$PIECE(LRRESULT,"^",2)
+6 IF (TEST["L")!(TEST["H")
Begin DoDot:1
+7 ;If no test name quit v3
IF $GET(^LAB(60,L60DFN,.1))=""
QUIT
+8 SET ORESULTS=$PIECE(^LAB(60,L60DFN,.1),"^",1)_"="_$PIECE(LRRESULT,"^",1)
+9 ;set ABNORMAL results in Order file
DO ORUPDAT
End DoDot:1
QUIT
+10 QUIT
+11 ;
PAN60 ;
+1 ;Clear for the next order file
SET ORESULTS=""
+2 ; S DAT60LV1=$G(^LAB(60,LRSUB,0)) Q:DAT60LV1=""
+3 ;
+4 ; Lab(60 DFN in LOR(69 was a Panel of test.
+5 ; If an abnormal test in the panel test loop thru the panel test to pull each individual test
+6 ; also loop Thru the LR from the start to pull the results to put with the test from LAB(60
+7 SET LRSUB=""
+8 ; Loop Thru LR file to pull individual test results when from a panel of test.
+9 SET RCNT=0
+10 SET LSTEST=""
+11 SET LABPNUM=0
+12 FOR
SET LABPNUM=$ORDER(^LAB(60,PANEL,2,LABPNUM))
if LABPNUM=""!(LABPNUM]"@")
QUIT
Begin DoDot:1
+13 SET LV60TST=$GET(^LAB(60,PANEL,2,LABPNUM,0))
if LV60TST=""
QUIT
+14 SET L60DFN=$PIECE(LV60TST,"^",1)
+15 ;If not test skip v3
IF L60DFN=""
QUIT
+16 ; If L60DFN not null but not valid quit v3
SET LRSUB=$GET(^LAB(60,L60DFN,.2))
+17 ; v3
IF LRSUB=""
QUIT
+18 SET LRSUB=$PIECE(^LAB(60,L60DFN,.2),"^",1)
+19 ;If no test quit
SET LRRESULT=$GET(^LR(LABDFN,TSTTYP,LRIVDAT,LRSUB))
if LRRESULT=""
QUIT
+20 ;If no results quit
SET TEST=$PIECE(LRRESULT,"^",2)
if LRRESULT=""
QUIT
+21 IF (TEST["L")!(TEST["H")
Begin DoDot:2
+22 SET RCNT=RCNT+1
+23 SET DAT60LV1=$GET(^LAB(60,L60DFN,0))
if DAT60LV1=""
QUIT
+24 SET LSTEST=LRSUB
+25 ;If no test name quit v3
IF $GET(^LAB(60,L60DFN,.1))=""
QUIT
+26 SET $PIECE(ORESULTS,",",RCNT)=$PIECE(^LAB(60,L60DFN,.1),"^",1)_"="_$PIECE(LRRESULT,"^",1)_" "
+27 ; S LRSUB=LRSUB+1 ;Bump to the next LR test results
End DoDot:2
QUIT
End DoDot:1
+28 ;set ABNORMAL results in Order file
IF ORESULTS'=""
DO ORUPDAT
+29 QUIT
+30 ;
ORUPDAT ; Update the OR(100, file Abnormal results
+1 ;
+2 SET CNT244=CNT244+1
+3 SET ^TMP("ORFIX",$JOB,0)=CNT244
+4 SET PTNAME=""
+5 SET OR0=$GET(^OR(100,OERRDFN,0))
+6 SET PTNAME=$$PTNM($PIECE(OR0,U,2))
+7 SET ^TMP("ORFIX",$JOB,CNT244)="PATIENT NAME="_PTNAME
+8 SET ^TMP("ORFIX",$JOB,CNT244,0)=" ORER FILE DFN="_OERRDFN
+9 SET ^TMP("ORFIX",$JOB,CNT244,1)=" LAB DATA LRDFN="_LABDFN
+10 IF PANEL=""
SET ^TMP("ORFIX",$JOB,CNT244,2)=" LABORATORY TEST IEN="_LSTEST
+11 IF PANEL'=""
SET ^TMP("ORFIX",$JOB,CNT244,2)=" LABORATORY TEST(PANEL) IEN="_PANEL
+12 SET ^TMP("ORFIX",$JOB,CNT244,3)=" ABNORMAL TEST RESULTS: "_ORESULTS
+13 SET $PIECE(^OR(100,OERRDFN,7),"^",2)=1
+14 SET $PIECE(^OR(100,OERRDFN,7),"^",3)=ORESULTS
+15 ;W !," ABNORMAL TEST RESULTS: ",ORESULTS
+16 ;
+17 ;S THISTEST=^OR(100,OERRDFN,7)
+18 ;W !,"Before update ^OR(100,"_OERRDFN_",7)=",THISTEST
+19 ;
+20 ;S THISTEST=^OR(100,OERRDFN,7)
+21 ;W !,"After update ^OR(100,"_OERRDFN_",7)=",THISTEST
+22 ;W !
+23 QUIT
+24 ;
+25 ;
+26 ;
MAIL ;Send results of cleanup in a mail message to initiator
+1 NEW I,XMSUB,XMTEXT,XMDUZ,XMY,DIFROM
+2 SET XMSUB="Patch OR*3*244 Clean up completed"
+3 SET XMDUZ="Patch OR*3*244 Clean up job"
+4 SET XMY(.5)=""
if $GET(DUZ)
SET XMY(DUZ)=""
+5 SET XMTEXT="^TMP(""ORTXT"",$J,"
+6 KILL ^TMP("ORTXT",$JOB)
+7 ; set up header and count
+8 SET I=1
+9 SET ^TMP("ORTXT",$JOB,I)="The reinstatement of Abnormal results has completed."
SET I=I+1
+10 SET ^TMP("ORTXT",$JOB,I)="Below is a listing of Abnormal results taken from Lab test and added to the Order file."
SET I=I+1
+11 SET ^TMP("ORTXT",$JOB,I)=""
SET I=I+1
+12 SET ^TMP("ORTXT",$JOB,I)=+$PIECE($GET(^TMP("ORFIX",$JOB,0)),U)_" orders had abnormal results added."
SET I=I+1
+13 SET ^TMP("ORTXT",$JOB,I)=""
SET I=I+1
+14 IF $GET(^TMP("ORFIX",$JOB,0))=0
SET ^TMP("ORTXT",$JOB,I)="No changes were made to your database."
SET I=I+1
+15 SET ^TMP("ORTXT",$JOB,I)=""
SET I=I+1
+16 ; set up message text
+17 SET CNT244=0
FOR
SET CNT244=$ORDER(^TMP("ORFIX",$JOB,CNT244))
if CNT244=""
QUIT
Begin DoDot:1
+18 SET ^TMP("ORTXT",$JOB,I)=^TMP("ORFIX",$JOB,CNT244)
SET I=I+1
+19 SET ^TMP("ORTXT",$JOB,I)=^TMP("ORFIX",$JOB,CNT244,0)
SET I=I+1
+20 SET ^TMP("ORTXT",$JOB,I)=^TMP("ORFIX",$JOB,CNT244,1)
SET I=I+1
+21 SET ^TMP("ORTXT",$JOB,I)=^TMP("ORFIX",$JOB,CNT244,2)
SET I=I+1
+22 SET ^TMP("ORTXT",$JOB,I)=^TMP("ORFIX",$JOB,CNT244,3)
SET I=I+1
+23 SET ^TMP("ORTXT",$JOB,I)=""
SET I=I+1
End DoDot:1
+24 ;send results
DO ^XMD
+25 QUIT
+26 ;
PTNM(IEN) ;Return pt name or -1 if unable to determine
+1 NEW DFN,VADM
+2 IF +IEN=0!(IEN'["DPT")
QUIT -1
+3 SET DFN=+IEN
+4 DO ^VADPT
+5 IF $GET(VADM(1))=""
QUIT -1
+6 QUIT $GET(VADM(1))
+7 ;
