Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LRRPLU

LRRPLU.m

Go to the documentation of this file.
  1. LRRPLU ;DALOI/JMC - Lab Report Performing Lab Utility ;02/22/13 10:11
  1. ;;5.2;LAB SERVICE;**350,427**;Sep 27, 1994;Build 33
  1. ;
  1. Q
  1. ;
  1. ;
  1. EDIT(LRDFN,LRSS,LRIDT) ; Add/edit performing lab for a section of a report
  1. ; Call with LRDFN = File #63 IEN
  1. ; LRSS = File #63 subscript
  1. ; LRIDT = File #63 inverse date/time of specimen
  1. ;
  1. ;
  1. N DIR,DIROUT,DIRUT,DUOUT,LRHLP,LRLST,LRPL,LRX,LRY,X,Y
  1. ; Autospy does not have an inverse date/time
  1. I LRSS="AU" S LRIDT=0
  1. I LRSS="MI",'($$GET^XPAR("ALL","LR ASK PERFORMING LAB MICRO",1,"Q")) D NOASK^LRRPLUA Q
  1. I LRSS?1(1"SP",1"CY",1"EM"),'($$GET^XPAR("ALL","LR ASK PERFORMING LAB AP",1,"Q")) D NOASK^LRRPLUA Q
  1. F D Q:$D(DIRUT)
  1. . K LRPL,LRLST
  1. . D RETLST^LRRPL(.LRPL,LRDFN,LRSS,LRIDT,2)
  1. . ;
  1. . I $D(LRPL(0)) D
  1. . . M LRLST=LRPL(0) K LRPL(0)
  1. . . S LRPL(.5)="Current performing lab assignments:",LRPL(.6)=" "
  1. . E S LRPL(.5)="Current performing lab assignments: None Listed"
  1. . D EN^DDIOL(.LRPL)
  1. . ;
  1. . K DIR,LRHLP
  1. . S DIR(0)="SO^1:Entire report;2:Specific sections of report"
  1. . I $D(LRLST) S DIR(0)=DIR(0)_";3:Delete performing laboratory"
  1. . E S DIR("B")=1
  1. . S DIR("A")="Designate performing laboratory for"
  1. . I $G(DIR("B"))'="" S DIR("?")="Enter a code from the list or '^' to exit."
  1. . E S DIR("?")="Enter a code from the list or <ENTER> to exit."
  1. . M LRHLP=LRPL
  1. . S X=$G(LRPL),LRHLP(X+1)=" ",LRHLP(X+2)=DIR("?")
  1. . S DIR("??")="^D EN^DDIOL(.LRHLP)"
  1. . D ^DIR
  1. . I $D(DIRUT) Q
  1. . I Y=1 D SET1(0) Q
  1. . I Y=2 D SET2 Q
  1. . I Y=3 D DEL Q
  1. ;
  1. Q
  1. ;
  1. ;
  1. SET1(LRSECT) ; Set performing lab for entire or major section of report.
  1. ; Update if already set otherwise create a new record.
  1. ; Call with LRSECT = section of report
  1. ;
  1. N DIR,DIROUT,DIRUT,DUOUT,LRDIE,LRDPL,LRFDA,LRFLAG,LRIEN,LRREF,LRPLAB
  1. S LRFLAG=0
  1. I LRSS?1(1"MI",1"SP",1"CY",1"EM") S LRFLAG=1
  1. S LRDPL=$$GET^XPAR("USR","LR VER DEFAULT PERFORMING LAB",1,"Q")
  1. I LRDPL<1 S LRDPL=DUZ(2)
  1. S LRPLAB=$$SELPL^LRVERA(LRDPL,LRFLAG)
  1. I LRPLAB<1 Q
  1. S LRREF=LRDFN_","_LRSS_","_LRIDT_","_LRSECT
  1. ;
  1. ; Confirm that user wants to add/update record.
  1. W !
  1. S DIR(0)="YO",DIR("B")="NO"
  1. S DIR("A")="Sure you want to "_$S($D(^LR(LRDFN,"PL","B",LRREF)):"update",1:"add")_" this record"
  1. D ^DIR
  1. I Y'=1 Q
  1. ;
  1. ; Update existing entry
  1. I $D(^LR(LRDFN,"PL","B",LRREF)) D Q
  1. . D UEE(LRDFN,LRREF,LRPLAB)
  1. . W !,"... assignment updated.",!
  1. ;
  1. ; Create new entry
  1. D CNE(LRDFN,LRREF,LRPLAB)
  1. W !,"... assignment created.",!
  1. ;
  1. Q
  1. ;
  1. ;
  1. SET2 ; Set performing lab for specific section of report
  1. ;
  1. N DIR,DIROUT,DIRUT,DUOUT,I,LRCNT,LRI,LRPLIEN,LRQUIT,LRREC,LRREF,LRROOT,LRSEC,LRSECT,LRX,LRY
  1. ; Find the current existing sections of the report
  1. S LRREF="",(LRI,LRQUIT,LRREC)=0
  1. S (LRROOT,LRX)=LRDFN_","_LRSS_","_LRIDT_","
  1. F S LRX=$O(^LR(LRDFN,"PL","B",LRX)) Q:LRX="" D Q:LRQUIT
  1. . I $P(LRROOT,",",1,3)'=$P(LRX,",",1,3) S LRQUIT=1 Q
  1. . S LRPLIEN=$O(^LR(LRDFN,"PL","B",LRX,0))
  1. . S LRI=$P(LRX,",",4,99),LRY="LRSEC("_LRDFN_",LRSS,"_LRIDT_",LRI)"
  1. . S @LRY=LRX_"^"_LRPLIEN
  1. ;
  1. I LRSS="MI" D MICHK
  1. I LRSS?1(1"SP",1"CY",1"EM") D APCHK
  1. I LRSS="AU" D AUCHK
  1. ;
  1. W !
  1. I $G(LRREC)<1 D Q
  1. . S DIR(0)="E",DIR("A",1)="NO sections to designate.",DIR("A")="Press any key to continue"
  1. . D ^DIR
  1. ;
  1. S LRCNT=$O(LRREC(""),-1)
  1. F I=1:1:LRCNT S DIR("A",I)=$J(I,11)_" - "_$P(LRREC(I),"^")
  1. S DIR("A")="Select the section to designate (1-"_LRCNT_"): "
  1. S DIR(0)="NOA^1:"_LRCNT_":0"
  1. S DIR("??")="^D EN^DDIOL(.LRPL)"
  1. D ^DIR
  1. I $D(DIRUT) Q
  1. ;
  1. S LRSECT=$P(LRREC(Y),"^",2)
  1. ;
  1. I LRSS="MI" D
  1. . S LRX="1^^^^1^^^1^^^1^^^^^1^^^^^^^^^^^^^^^1^"
  1. . I $P(LRX,"^",LRSECT)!(LRSECT=99) D SET1(LRSECT) Q
  1. . ;
  1. . S LRX="^1^1^1^^1^1^^1^1^^1^1^1^1^^1^1^1^1^1^1^1^1^1^1^1^1^1^1^"
  1. . I $P(LRX,"^",LRSECT) D
  1. . . N LRY
  1. . . D GETMULTI
  1. . . W ! S LRX=$$SELMULTI(.LRY)
  1. . . I LRX#1=.1 W ! K LRY D MIAB(.LRY,$P(LRX,",",5)) S LRX=$$SELMULTI(.LRY)
  1. . . S LRREF=$P(LRX,"^",3)
  1. . . I LRREF'="" D SETREF
  1. ;
  1. I LRSS?1(1"SP",1"CY",1"EM") D
  1. . I LRSECT=1.2!(LRSECT=97)!(LRSECT=99) D Q
  1. . . N LRY
  1. . . D GETMULTI
  1. . . W ! S LRX=$$SELMULTI(.LRY),LRREF=$P(LRX,"^",3)
  1. . . I LRREF'="" D SETREF
  1. . I LRSECT=2 D Q
  1. . . N LRY
  1. . . D GETMULTI
  1. . . W ! S LRX=$$SELMULTI(.LRY)
  1. . . I LRX#1=.1 W ! K LRY D APSS(.LRY,$P(LRX,",",5)) S LRX=$$SELMULTI(.LRY)
  1. . . S LRREF=$P(LRX,"^",3)
  1. . . I LRREF'="" D SETREF
  1. . D SET1(LRSECT)
  1. ;
  1. I LRSS="AU" D
  1. . I LRSECT=84!(LRSECT="AZC") D Q
  1. . . N LRY
  1. . . D GETMULTI
  1. . . W ! S LRX=$$SELMULTI(.LRY),LRREF=$P(LRX,"^",3)
  1. . . I LRREF'="" D SETREF
  1. . I LRSECT="AY" D Q
  1. . . N LRY
  1. . . D GETMULTI
  1. . . W ! S LRX=$$SELMULTI(.LRY)
  1. . . I LRX#1=.1 W ! K LRY D APSS(.LRY,$P(LRX,",",3)) S LRX=$$SELMULTI(.LRY)
  1. . . S LRREF=$P(LRX,"^",3)
  1. . . I LRREF'="" D SETREF
  1. . D SET1(LRSECT)
  1. ;
  1. Q
  1. ;
  1. ;
  1. SETREF ; Set reference to performing lab in file #63
  1. ; Update if already set otherwise create a new record.
  1. ;
  1. ; Confirm that user wants to add/update record.
  1. N DIR,DIROUT,DIRUT,DUOUT,LRDIE,LRDPL,LRFDA,LRFLAG,LRIEN,LRPLAB
  1. ;
  1. S LRFLAG=0
  1. I LRSS?1(1"MI",1"SP",1"CY",1"EM",1"AU") S LRFLAG=1
  1. S LRDPL=$$GET^XPAR("USR","LR VER DEFAULT PERFORMING LAB",1,"Q")
  1. I LRDPL<1 S LRDPL=DUZ(2)
  1. S LRPLAB=$$SELPL^LRVERA(LRDPL,LRFLAG)
  1. I LRPLAB<1 Q
  1. ;
  1. W !
  1. K DIR
  1. S DIR(0)="YO",DIR("B")="NO"
  1. S DIR("A")="Sure you want to "_$S($D(^LR(LRDFN,"PL","B",LRREF)):"update",1:"add")_" this record"
  1. D ^DIR
  1. I Y'=1 Q
  1. ;
  1. ; Update existing entry
  1. I $D(^LR(LRDFN,"PL","B",LRREF)) D Q
  1. . D UEE(LRDFN,LRREF,LRPLAB)
  1. . W !,"... assignment updated.",!
  1. ;
  1. ; Create new entry
  1. D CNE(LRDFN,LRREF,LRPLAB)
  1. W !,"... assignment created.",!
  1. ;
  1. Q
  1. ;
  1. ;
  1. DEL ; Delete existing performing laboratory designations.
  1. ;
  1. N DIR,DIROUT,DIRUT,DTOUT,DUOUT,LRCNT,LRFDA,LRIEN,X,Y
  1. S LRCNT=$O(LRLST(""),-1)
  1. ;
  1. W !
  1. I LRCNT=1 S Y=1
  1. I LRCNT>1 D Q:$D(DIRUT)
  1. . S DIR("A")="Select the section to delete (1-"_LRCNT_"): "
  1. . F I=1:1:LRCNT S DIR("A",I)=$J(I,11)_" - "_$P(LRLST(I),"^",3)
  1. . S DIR(0)="NOA^1:"_LRCNT_":0"
  1. . D ^DIR
  1. ;
  1. S LRIEN=$P(LRLST(Y),"^",2)
  1. ;
  1. ; Confirm that user wants to delete record.
  1. K DIR
  1. S DIR(0)="YO",DIR("B")="NO"
  1. S DIR("A")="Sure you want to delete this performing lab assignment"
  1. D ^DIR
  1. I Y'=1 W !,"... deletion cancelled.",! Q
  1. ;
  1. ; Delete existing entry
  1. D DEE(LRIEN_","_LRDFN_",")
  1. ;
  1. I '$D(^LR(LRDFN,"PL",LRIEN)) W !,"... assignment deleted.",!
  1. E W "... assignment NOT deleted.",!
  1. ;
  1. Q
  1. ;
  1. ;
  1. UEE(LRDFN,LRREF,LRPLAB) ; Update existing entry
  1. ; Call with LRDFN = File #63 IEN
  1. ; LRREF = File #63 subscript reference
  1. ; LRPLAB = Performing lab as IEN in file #4
  1. ;
  1. N LRDIE,LRFDA,LRIEN
  1. S LRIEN=$O(^LR(LRDFN,"PL","B",LRREF,0))
  1. S LRFDA(1,63.00012,LRIEN_","_LRDFN_",",.02)=LRPLAB
  1. D FILE^DIE("","LRFDA(1)","LRDIE(1)")
  1. Q
  1. ;
  1. ;
  1. CNE(LRDFN,LRREF,LRPLAB) ; Create new entry
  1. ; Call with LRDFN = File #63 IEN
  1. ; LRREF = File #63 subscript reference
  1. ; LRPLAB = Performing lab as IEN in file #4
  1. ;
  1. N LRDIE,LRFDA,LRIEN
  1. S LRFDA(1,63.00012,"+1,"_LRDFN_",",.01)=LRREF
  1. S LRFDA(1,63.00012,"+1,"_LRDFN_",",.02)=LRPLAB
  1. D UPDATE^DIE("","LRFDA(1)","LRIEN","LRDIE(1)")
  1. Q
  1. ;
  1. ;
  1. DEE(LRIENS) ; Delete existing entry
  1. ; Call with LRRIENS = File #63 performing lab reference IENS
  1. ;
  1. N LRDIE,LRFDA
  1. S LRFDA(1,63.00012,LRIENS,.01)="@"
  1. D FILE^DIE("","LRFDA(1)","LRDIE(1)")
  1. Q
  1. ;
  1. ;
  1. MICHK ; Check MI for sections to link to a performing lab
  1. ;
  1. N I,LRI
  1. ;
  1. ; Bacteriology section
  1. S LRI=1
  1. I $D(^LR(LRDFN,LRSS,LRIDT,LRI)) D
  1. . D MICHK1
  1. . N LRJ
  1. . F LRJ=5,6 I $P(^LR(LRDFN,LRSS,LRIDT,LRI),"^",LRJ)'="" D
  1. . . S LRREF=LRROOT_LRI_";"_LRJ,LRREC=LRREC+1 D MICHK^LRRPL S $P(LRREC(LRREC),"^",2)=LRI_";"_LRJ
  1. . . S LRREC(LRREC,0)=$G(LRSEC(LRDFN,LRSS,LRIDT,LRI_";"_LRJ))
  1. ;
  1. ; Gram stain/Organism/Susceptibility/Remark section
  1. F LRI=2,3,4 I $O(^LR(LRDFN,LRSS,LRIDT,LRI,0)) D
  1. . D MICHK2
  1. . I LRI=3 D BUGCHK
  1. ;
  1. ; Parasite section - check for parasite and stage info
  1. S LRI=5
  1. I $D(^LR(LRDFN,LRSS,LRIDT,LRI)) D MICHK1
  1. ;
  1. F LRI=6,7 I $O(^LR(LRDFN,LRSS,LRIDT,LRI,0)) D
  1. . D MICHK2
  1. . I LRI=6 D BUGCHK
  1. ;
  1. ; Mycology section
  1. S LRI=8
  1. I $D(^LR(LRDFN,LRSS,LRIDT,LRI)) D MICHK1
  1. ;
  1. F LRI=9,10,15 I $O(^LR(LRDFN,LRSS,LRIDT,LRI,0)) D
  1. . D MICHK2
  1. . I LRI=9 D BUGCHK
  1. ;
  1. ; Mycobacteria section - also check for AFB stain
  1. S LRI=11
  1. I $D(^LR(LRDFN,LRSS,LRIDT,LRI)) D
  1. . D MICHK1
  1. . I $P(^LR(LRDFN,LRSS,LRIDT,LRI),"^",3)'="" D
  1. . . S LRREF=LRROOT_LRI_";3",LRREC=LRREC+1 D MICHK^LRRPL S $P(LRREC(LRREC),"^",2)=LRI_";3"
  1. . . S LRREC(LRREC,0)=$G(LRSEC(LRDFN,LRSS,LRIDT,LRI_";3"))
  1. ;
  1. ; TB/Organism/Susceptibilityr/Remark section
  1. F LRI=12,13,14 I $O(^LR(LRDFN,LRSS,LRIDT,LRI,0)) D
  1. . D MICHK2
  1. . I LRI=12 D BUGCHK
  1. ;
  1. ; Virology section
  1. S LRI=16
  1. I $D(^LR(LRDFN,LRSS,LRIDT,LRI)) D MICHK1
  1. ;
  1. F LRI=17,18 I $O(^LR(LRDFN,LRSS,LRIDT,LRI,0)) D
  1. . D MICHK2
  1. . I LRI=17 D BUGCHK
  1. ;
  1. ; Various preliminary comment sections
  1. F LRI=19:1:30 I $O(^LR(LRDFN,LRSS,LRIDT,LRI,0)) D MICHK2
  1. ;
  1. ; Sterility Results
  1. S LRI=31
  1. I $D(^LR(LRDFN,LRSS,LRIDT,LRI)) D MICHK1
  1. ;
  1. ; Comment on Specimen
  1. S LRI=99
  1. I $D(^LR(LRDFN,LRSS,LRIDT,LRI)) D MICHK1
  1. ;
  1. Q
  1. ;
  1. ;
  1. MICHK1 ; Common MI checking logic
  1. ;
  1. S LRREF=LRROOT_LRI,LRREC=LRREC+1 D MICHK^LRRPL S $P(LRREC(LRREC),"^",2)=LRI
  1. S LRREC(LRREC,0)=$G(LRSEC(LRDFN,LRSS,LRIDT,LRI))
  1. Q
  1. ;
  1. ;
  1. MICHK2 ; Common MI checking logic
  1. ;
  1. S LRREF=LRROOT_LRI_",0",LRREC=LRREC+1 D MICHK^LRRPL S $P(LRREC(LRREC),"^",2)=LRI
  1. S LRREC(LRREC,0)=$G(LRSEC(LRDFN,LRSS,LRIDT,LRI,0))
  1. Q
  1. ;
  1. ;
  1. APCHK ; Check AP for sections to link to a performing lab
  1. ;
  1. N LRI
  1. ;
  1. F LRI=.2,.3,.4,.5,1,1.1,1.3,1.4 D
  1. . I LRI=1.3,LRSS'="SP" Q
  1. . I '$O(^LR(LRDFN,LRSS,LRIDT,LRI,0)) Q
  1. . S LRREF=LRROOT_LRI_",0",LRREC=LRREC+1 D APCHK^LRRPL S $P(LRREC(LRREC),"^",2)=LRI
  1. . S LRREC(LRREC,0)=$G(LRSEC(LRDFN,LRSS,LRIDT,LRI))
  1. ;
  1. ; Supplementary Report section (1.2)
  1. S LRI=1.2
  1. I $D(^LR(LRDFN,LRSS,LRIDT,LRI)) D
  1. . S LRREF=LRROOT_LRI_",0",LRREC=LRREC+1 D APCHK^LRRPL S $P(LRREC(LRREC),"^",2)=LRI
  1. . S LRREC(LRREC,0)=$G(LRSEC(LRDFN,LRSS,LRIDT,LRI))
  1. ;
  1. ; Special studies (2)
  1. S LRI=2
  1. I $D(^LR(LRDFN,LRSS,LRIDT,LRI)) D
  1. . N LRJ
  1. . S LRJ=0
  1. . F S LRJ=$O(^LR(LRDFN,LRSS,LRIDT,LRI,LRJ)) Q:'LRJ I $O(^LR(LRDFN,LRSS,LRIDT,LRI,LRJ,5,0)) D Q
  1. . . S LRREF=LRROOT_LRI_",0",LRREC=LRREC+1 D APCHK^LRRPL S $P(LRREC(LRREC),"^",2)=LRI
  1. . . S LRREC(LRREC,0)=$G(LRSEC(LRDFN,LRSS,LRIDT,LRI))
  1. ;
  1. ; Delayed Report Comment (97) / Comment on Specimen (99)
  1. F LRI=97,99 I $D(^LR(LRDFN,LRSS,LRIDT,LRI)) D
  1. . S LRREF=LRROOT_LRI,LRREC=LRREC+1 D APCHK^LRRPL S $P(LRREC(LRREC),"^",2)=LRI
  1. . S LRREC(LRREC,0)=$G(LRSEC(LRDFN,LRSS,LRIDT,LRI))
  1. ;
  1. Q
  1. ;
  1. ;
  1. AUCHK ; Check AU for sections to link to a performing lab
  1. ;
  1. N LRI
  1. ;
  1. ; Clinical Diagnoses (81) / Pathological Diagnoses (82)
  1. F LRI=81,82 D
  1. . I '$O(^LR(LRDFN,LRI,0)) Q
  1. . S LRREF=LRROOT_LRI,LRREC=LRREC+1 D AUCHK^LRRPL S $P(LRREC(LRREC),"^",2)=LRI
  1. . S LRREC(LRREC,0)=$G(LRSEC(LRDFN,LRI))
  1. ;
  1. ; Supplementary Report section (84)
  1. S LRI=84
  1. I $D(^LR(LRDFN,LRI)) D
  1. . S LRREF=LRROOT_LRI_",0",LRREC=LRREC+1 D AUCHK^LRRPL S $P(LRREC(LRREC),"^",2)=LRI
  1. . S LRREC(LRREC,0)=$G(LRSEC(LRDFN,LRI))
  1. .
  1. ; Special studies (AY)
  1. S LRI="AY"
  1. I $D(^LR(LRDFN,LRI)) D
  1. . N LRJ
  1. . S LRJ=0
  1. . F S LRJ=$O(^LR(LRDFN,LRI,LRJ)) Q:'LRJ I $O(^LR(LRDFN,LRI,LRJ,5,0)) D Q
  1. . . S LRREF=LRROOT_LRI_",0",LRREC=LRREC+1 D AUCHK^LRRPL S $P(LRREC(LRREC),"^",2)=LRI
  1. . . S LRREC(LRREC,0)=$G(LRSEC(LRDFN,"AY"))
  1. ;
  1. ; Autospy comments (AZC)
  1. S LRI="AZC"
  1. I $D(^LR(LRDFN,LRI)) D
  1. . S LRREF=LRROOT_LRI,LRREC=LRREC+1 D AUCHK^LRRPL S $P(LRREC(LRREC),"^",2)=LRI
  1. . S LRREC(LRREC,0)=$G(LRSEC(LRDFN,"AZC"))
  1. ;
  1. Q
  1. ;
  1. ;
  1. BUGCHK ; Check for organism/susceptibility
  1. ; Only check for susceptibilities on bacteria (3) or TB (12).
  1. ;
  1. N LRJ,LRK
  1. S LRJ=0
  1. F S LRJ=$O(^LR(LRDFN,LRSS,LRIDT,LRI,LRJ)) Q:'LRJ D
  1. . S LRREC(LRREC,LRJ)=$P(^LAB(61.2,+^(LRJ,0),0),"^")
  1. . S LRREC(LRREC,LRJ,0)=$G(LRSEC(LRDFN,LRSS,LRIDT,LRI,LRJ))
  1. . I LRI'=3,LRI'=12 Q
  1. . S LRK=2
  1. . F S LRK=$O(^LR(LRDFN,LRSS,LRIDT,LRI,LRJ,LRK)) Q:'LRK!(LRK'<3) D
  1. . . S LRREC(LRREC,LRJ,LRK)=$$GETDRUG^LRRPL(LRI,LRK)
  1. . . S LRREC(LRREC,LRJ,LRK,0)=$G(LRSEC(LRDFN,LRSS,LRIDT,LRI,LRJ,LRK))
  1. Q
  1. ;
  1. ;
  1. SELMULTI(LRY) ; Handle multiple items type selection
  1. ; Flag whole section or indivudual items with performing lab.
  1. ; Present list of items and allow all or selected items to be designated
  1. ;
  1. ; Call with LRY = array of items to select/designate
  1. ; Returns LRX = item selected
  1. ;
  1. N DIR,DIROUT,DIRUT,DTOUT,DUOUT,I,LRCNT,LRDEC,LRX
  1. ;
  1. S (I,LRDEC)=0,LRCNT=$O(LRY(""),-1)
  1. F S I=$O(LRY(I)) Q:'I S DIR("A",I+1)=$J($$LJ^XLFSTR(I,4),13)_" - "_$P(LRY(I),"^") S:I#1=.1 LRDEC=1
  1. S DIR("A")="Select the item to designate (1-"_LRCNT_"): "
  1. S DIR(0)="NAO^1:"_LRCNT_":"_LRDEC,DIR("PRE")="I X'="""",'$D(DTOUT),'$D(LRY(X)) K X"
  1. S DIR("??")="^D EN^DDIOL(.LRPL)"
  1. D ^DIR
  1. I $D(DIRUT) S LRX=-1
  1. E S LRX=Y_"^"_LRY(Y)
  1. ;
  1. Q LRX
  1. ;
  1. ;
  1. GETMULTI ; Build array of existing items in multiple
  1. N LRI
  1. K LRY
  1. S LRI=0
  1. ;
  1. I LRSS="MI" D MIMULTI Q
  1. I LRSS?1(1"SP",1"CY",1"EM",1"AU") D APMULTI Q
  1. ;
  1. Q
  1. ;
  1. ;
  1. MIMULTI ; Build array for MI subscript results.
  1. ;
  1. N LRX,X
  1. S LRX="^1^^1^^^1^^^1^^^1^1^1^^^1^1^1^1^1^1^1^1^1^1^1^1^1"
  1. I $P(LRX,"^",LRSECT) D Q
  1. . F S LRI=$O(^LR(LRDFN,LRSS,LRIDT,LRSECT,LRI)) Q:'LRI D
  1. . . S X=^LR(LRDFN,LRSS,LRIDT,LRSECT,LRI,0)
  1. . . I LRSECT=14 S X=$P(X,"^")
  1. . . S LRY(LRI)=X_"^"_LRROOT_LRSECT_","_LRI_",0"
  1. . S LRI=$O(LRY(""),-1)+1
  1. . S LRY(LRI)="ALL "_$S(LRSECT=14:"ANTIBIOTIC(for SERUM LEVEL)",1:"comments")_"^"_LRROOT_LRSECT_",0"
  1. ;
  1. S LRX="^^1^^^1^^^1^^^1^^^^^1^"
  1. I $P(LRX,"^",LRSECT) D Q
  1. . F S LRI=$O(^LR(LRDFN,LRSS,LRIDT,LRSECT,LRI)) Q:'LRI D
  1. . . S LRY(LRI)=$P(^LAB(61.2,+^(LRI,0),0),"^")_"^"_LRROOT_LRSECT_","_LRI_",0"
  1. . . I LRSECT=3!(LRSECT=12) D
  1. . . . N LRFLAG
  1. . . . S X=$O(^LR(LRDFN,LRSS,LRIDT,LRSECT,LRI,2)),LRFLAG=0
  1. . . . I X\1=2 S LRFLAG=1
  1. . . . I LRSECT=3,$O(^LR(LRDFN,LRSS,LRIDT,LRSECT,LRI,3,0)) S LRFLAG=1
  1. . . . I LRFLAG<1 Q
  1. . . . S LRY(LRI+.1)=$P(LRY(LRI),"^")_" Specific Susceptibilities"_"^"_LRROOT_LRSECT_","_LRI_","
  1. . . . S $P(LRY(LRI),"^")=$P(LRY(LRI),"^")_" including All Susceptibilities"
  1. . S LRI=$O(LRY(""),-1)+1\1,LRY(LRI)="ALL items^"_LRROOT_LRSECT_",0"
  1. ;
  1. Q
  1. ;
  1. ;
  1. MIAB(LRY,LRORG) ; Build array for MI susceptbility results.
  1. ; Call with LRY = array to return selections
  1. ; LRORG = organism subscript
  1. ;
  1. N LRDN,LRI,LRJ
  1. ;
  1. S LRI=0,LRJ=2
  1. F S LRJ=$O(^LR(LRDFN,LRSS,LRIDT,LRSECT,LRORG,LRJ)) Q:'LRJ!(LRJ'<3) D
  1. . S LRDN=$$GETDRUG^LRRPL(LRSECT,LRJ)
  1. . S LRI=LRI+1,LRY(LRI)=LRDN_"^"_LRROOT_LRSECT_","_LRORG_","_LRJ
  1. ;
  1. ; Collect free text antibiotics (#200)
  1. I LRSECT=3,$D(^LR(LRDFN,LRSS,LRIDT,LRSECT,LRORG,3,0)) D
  1. . S LRJ=0
  1. . F S LRJ=$O(^LR(LRDFN,LRSS,LRIDT,LRSECT,LRORG,3,LRJ)) Q:'LRJ D
  1. . . S LRDN=$P(^LR(LRDFN,LRSS,LRIDT,LRSECT,LRORG,3,LRJ,0),"^")
  1. . . S LRI=LRI+1,LRY(LRI)=LRDN_"^"_LRROOT_LRSECT_","_LRORG_",3,"_LRJ_",0"
  1. Q
  1. ;
  1. ;
  1. APMULTI ; Build array for AP subscript results.
  1. ;
  1. ; Autopsy comments (AZC)
  1. I LRSS="AU",LRSECT="AZC" D Q
  1. . F S LRI=$O(^LR(LRDFN,LRSECT,LRI)) Q:'LRI S LRY(LRI)=^(LRI,0)_"^"_LRROOT_LRSECT_","_LRI_",0"
  1. . S LRI=$O(LRY(""),-1)+1,LRY(LRI)="ALL comments^"_LRROOT_LRSECT_",0"
  1. ;
  1. ; Autopsy Supplementary reports (84)
  1. I LRSS="AU",LRSECT=84 D Q
  1. . F S LRI=$O(^LR(LRDFN,LRSECT,LRI)) Q:'LRI S LRX=$$FMTE^XLFDT(+^(LRI,0),"1MZ"),LRY(LRI)=LRX_"^"_LRROOT_LRSECT_","_LRI_",0"
  1. . S LRI=$O(LRY(""),-1)+1,LRY(LRI)="ALL Supplementary Reports^"_LRROOT_LRSECT_",0"
  1. ;
  1. ; Autopsy Special Studies (AY)
  1. I LRSS="AU",LRSECT="AY" D Q
  1. . F S LRI=$O(^LR(LRDFN,LRSECT,LRI)) Q:'LRI D
  1. . . S LRX=$P(^LAB(61,+^(LRI,0),0),"^"),LRY(LRI)=LRX_"^"_LRROOT_LRSECT_","_LRI_",0"
  1. . . S LRY(LRI+.1)=$P(LRY(LRI),"^")_" Specific Special Studies"_"^"_LRROOT_LRSECT_","_LRI_","
  1. . . S $P(LRY(LRI),"^")=$P(LRY(LRI),"^")_" including All Special Studies"
  1. . S LRI=$O(LRY(""),-1)+1\1,LRY(LRI)="ALL Special Studies Reports^"_LRROOT_LRSECT_",0"
  1. ;
  1. ; Comment fields #97 and #99
  1. I LRSECT=97!(LRSECT=99) D Q
  1. . F S LRI=$O(^LR(LRDFN,LRSS,LRIDT,LRSECT,LRI)) Q:'LRI S LRY(LRI)=^(LRI,0)_"^"_LRROOT_LRSECT_","_LRI_",0"
  1. . S LRI=$O(LRY(""),-1)+1,LRY(LRI)="ALL comments^"_LRROOT_LRSECT_",0"
  1. ;
  1. ; Supplementary Reports
  1. I LRSECT=1.2 D Q
  1. . F S LRI=$O(^LR(LRDFN,LRSS,LRIDT,LRSECT,LRI)) Q:'LRI S LRX=$$FMTE^XLFDT(+^(LRI,0),"1MZ"),LRY(LRI)=LRX_"^"_LRROOT_LRSECT_","_LRI_",0"
  1. . S LRI=$O(LRY(""),-1)+1,LRY(LRI)="ALL Supplementary Reports^"_LRROOT_LRSECT_",0"
  1. ;
  1. ; Special Studies
  1. I LRSECT=2 D Q
  1. . F S LRI=$O(^LR(LRDFN,LRSS,LRIDT,LRSECT,LRI)) Q:'LRI D
  1. . . S LRX=$P(^LAB(61,+^(LRI,0),0),"^"),LRY(LRI)=LRX_"^"_LRROOT_LRSECT_","_LRI_",0"
  1. . . S LRY(LRI+.1)=$P(LRY(LRI),"^")_" Specific Special Studies"_"^"_LRROOT_LRSECT_","_LRI_","
  1. . . S $P(LRY(LRI),"^")=$P(LRY(LRI),"^")_" including All Special Studies"
  1. . S LRI=$O(LRY(""),-1)+1\1,LRY(LRI)="ALL Special Studies Reports^"_LRROOT_LRSECT_",0"
  1. ;
  1. Q
  1. ;
  1. ;
  1. APSS(LRY,LRORGT) ; Build array for AP special studies.
  1. ; Call with LRY = array to return selections
  1. ; LRORGT = organ/tissue ien
  1. ;
  1. N LRI,LRJ,LRS,LRSST,LRSUB
  1. ;
  1. S (LRI,LRJ)=0
  1. ; Autopsy Special Studies (AY)
  1. I LRSS="AU",LRSECT="AY" D Q
  1. . F S LRJ=$O(^LR(LRDFN,LRSECT,LRORGT,5,LRJ)) Q:'LRJ D
  1. . . S LRS=^LR(LRDFN,LRSECT,LRORGT,5,LRJ,0),LRSST=$$EXTERNAL^DILFD(63.26,.01,"",$P(LRS,"^"),"")
  1. . . S LRI=LRI+1,LRY(LRI)=LRSST_"^"_LRROOT_LRSECT_","_LRORGT_",5,"_LRJ
  1. ;
  1. S LRSUB=$S(LRSS="SP":63.819,LRSS="CY":63.919,1:63.219)
  1. F S LRJ=$O(^LR(LRDFN,LRSS,LRIDT,LRSECT,LRORGT,5,LRJ)) Q:'LRJ D
  1. . S LRS=^LR(LRDFN,LRSS,LRIDT,LRSECT,LRORGT,5,LRJ,0),LRSST=$$EXTERNAL^DILFD(LRSUB,.01,"",$P(LRS,"^"),"")
  1. . S LRI=LRI+1,LRY(LRI)=LRSST_"^"_LRROOT_LRSECT_","_LRORGT_",5,"_LRJ
  1. Q