- PXEXINQ ;SLC/PKR - Exam Inquire. ;03/21/2022
- ;;1.0;PCE PATIENT CARE ENCOUNTER;**211,217**;Aug 12, 1996;Build 134
- ;
- ;==========================================
- BEXINQ(IEN) ;Display an Exam inquiry, defaults to the Browser.
- N BOP,DIR0,OUTPUT,TITLE,TYPE
- I '$D(^AUTTEXAM(IEN)) Q
- S TITLE="Exam Inquiry"
- D EXINQ(IEN,.OUTPUT)
- S BOP=$$BORP^PXUTIL("B")
- I BOP="" Q
- I BOP="B" D BROWSE^DDBR("OUTPUT","NR",TITLE)
- I BOP="P" D GPRINT^PXUTIL("OUTPUT")
- Q
- ;
- ;==========================================
- EXINQ(IEN,OUTPUT) ;Exam inquiry, return the formatted text in OUTPUT.
- ;Use 80 column output.
- N CODE,CODELIST,CODESYS,IENSTR,IND,INDXDT,LEN,MAPDT
- N NL,NSP,RM,T100,TEMP,TEXT,WPARRAY
- S RM=80
- S TEMP=^AUTTEXAM(IEN,0)
- S IENSTR="No. "_IEN
- S OUTPUT(1)=$$REPEAT^XLFSTR("-",RM)
- S TEXT=$P(TEMP,U,1)
- S NSP=RM-$L(TEXT)-1
- S OUTPUT(2)=TEXT_$$RJ^XLFSTR(IENSTR,NSP," ")
- S OUTPUT(3)=$$REPEAT^XLFSTR("-",RM)
- S OUTPUT(4)="Print Name: "_$$GET1^DIQ(9999999.15,IEN,200)
- S T100=^AUTTEXAM(IEN,100)
- S OUTPUT(5)="Class: "_$$GET1^DIQ(9999999.15,IEN,100)
- S OUTPUT(6)="Sponsor: "_$$GET1^DIQ(9999999.15,IEN,101)
- S OUTPUT(7)="Sex Specific: "_$$GET1^DIQ(9999999.15,IEN,.03)
- S OUTPUT(8)="Inactive Flag: "_$$GET1^DIQ(9999999.15,IEN,.04)
- S OUTPUT(9)=""
- S OUTPUT(10)="Description:"
- S NL=10
- S TEMP=$$GET1^DIQ(9999999.15,IEN,201,"","WPARRAY")
- I TEMP="" S NL=NL+1,OUTPUT(NL)=""
- I TEMP="WPARRAY" D
- . S IND=0
- . F S IND=$O(WPARRAY(IND)) Q:IND="" S NL=NL+1,OUTPUT(NL)=WPARRAY(IND)
- . K WPARRAY
- ;
- ;Mapped Codes.
- S IND=0
- F S IND=+$O(^AUTTEXAM(IEN,210,IND)) Q:IND=0 D
- . S TEMP=^AUTTEXAM(IEN,210,IND,0)
- . S CODESYS=$P(TEMP,U,1),CODE=$P(TEMP,U,2)
- . S MAPDT=$P(TEMP,U,3),INDXDT=$P(TEMP,U,4)
- . I CODE'="" S CODELIST(CODESYS,CODE)=MAPDT_U_INDXDT
- D MCDISP^PXMCODES(.CODELIST,.NL,.OUTPUT)
- ;
- ;Deleted code mappings.
- I $P($G(^AUTTEXAM(IEN,230,0)),U,4)>0 D
- . S NL=NL+1,OUTPUT(NL)=""
- . S NL=NL+1,OUTPUT(NL)=""
- . S NL=NL+1,OUTPUT(NL)="Deleted Code Mappings"
- . S IND=0
- . F S IND=+$O(^AUTTEXAM(IEN,230,IND)) Q:IND=0 D
- .. S TEMP=^AUTTEXAM(IEN,230,IND,0)
- .. S NL=NL+1,OUTPUT(NL)=""
- .. S NL=NL+1,OUTPUT(NL)=" Coding System: "_$P(TEMP,U,1)_" Code: "_$P(TEMP,U,2)
- .. S NL=NL+1,OUTPUT(NL)=" Date deleted: "_$$FMTE^XLFDT($P(TEMP,U,3),"5Z")
- .. S OUTPUT(NL)=OUTPUT(NL)_" Deleted by: "_$$GET1^DIQ(200,$P(TEMP,U,4),.01)
- .. S NL=NL+1,OUTPUT(NL)=" Mapped Source Entry removal completion date: "_$$FMTE^XLFDT($P(TEMP,U,5),"5Z")
- . S NL=NL+1,OUTPUT(NL)=""
- ;
- S NL=NL+1,OUTPUT(NL)=""
- S NL=NL+1,OUTPUT(NL)=" Value Range"
- S TEMP=$G(^AUTTEXAM(IEN,220))
- I TEMP="" S NL=NL+1,OUTPUT(NL)="Not defined"
- E D
- . S NL=NL+1,OUTPUT(NL)=" Minimum Value Maximum Value UCUM Code"
- . S NL=NL+1,OUTPUT(NL)=$S($E(TEMP,1)="-":"",1:" ")_$P(TEMP,U,1)
- . S LEN=$L(OUTPUT(NL)),NSP=30-LEN
- . S OUTPUT(NL)=OUTPUT(NL)_$$REPEAT^XLFSTR(" ",NSP)_$P(TEMP,U,2)
- . N UCUMDATA,UCUMIEN
- . S UCUMIEN=+$P(TEMP,U,4)
- . I UCUMIEN>0 D
- ..;ICR #6225
- .. D UCUMDATA^LEXMUCUM(UCUMIEN,.UCUMDATA)
- .. S LEN=$L(OUTPUT(NL)),NSP=55-LEN
- .. S OUTPUT(NL)=OUTPUT(NL)_$$REPEAT^XLFSTR(" ",NSP)_UCUMDATA(UCUMIEN,"UCUM CODE")
- .. S NL=NL+1,OUTPUT(NL)=""
- .. S NL=NL+1,OUTPUT(NL)="UCUM Description: "_UCUMDATA(UCUMIEN,"DESCRIPTION")
- .. S NL=NL+1,OUTPUT(NL)="Prompt Caption: "_$P(TEMP,U,5)
- .. S NL=NL+1,OUTPUT(NL)="UCUM Display: "_$$EXTERNAL^DILFD(9999999.15,225,"",$P(TEMP,U,6))
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXEXINQ 3457 printed Feb 18, 2025@23:55:06 Page 2
- PXEXINQ ;SLC/PKR - Exam Inquire. ;03/21/2022
- +1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**211,217**;Aug 12, 1996;Build 134
- +2 ;
- +3 ;==========================================
- BEXINQ(IEN) ;Display an Exam inquiry, defaults to the Browser.
- +1 NEW BOP,DIR0,OUTPUT,TITLE,TYPE
- +2 IF '$DATA(^AUTTEXAM(IEN))
- QUIT
- +3 SET TITLE="Exam Inquiry"
- +4 DO EXINQ(IEN,.OUTPUT)
- +5 SET BOP=$$BORP^PXUTIL("B")
- +6 IF BOP=""
- QUIT
- +7 IF BOP="B"
- DO BROWSE^DDBR("OUTPUT","NR",TITLE)
- +8 IF BOP="P"
- DO GPRINT^PXUTIL("OUTPUT")
- +9 QUIT
- +10 ;
- +11 ;==========================================
- EXINQ(IEN,OUTPUT) ;Exam inquiry, return the formatted text in OUTPUT.
- +1 ;Use 80 column output.
- +2 NEW CODE,CODELIST,CODESYS,IENSTR,IND,INDXDT,LEN,MAPDT
- +3 NEW NL,NSP,RM,T100,TEMP,TEXT,WPARRAY
- +4 SET RM=80
- +5 SET TEMP=^AUTTEXAM(IEN,0)
- +6 SET IENSTR="No. "_IEN
- +7 SET OUTPUT(1)=$$REPEAT^XLFSTR("-",RM)
- +8 SET TEXT=$PIECE(TEMP,U,1)
- +9 SET NSP=RM-$LENGTH(TEXT)-1
- +10 SET OUTPUT(2)=TEXT_$$RJ^XLFSTR(IENSTR,NSP," ")
- +11 SET OUTPUT(3)=$$REPEAT^XLFSTR("-",RM)
- +12 SET OUTPUT(4)="Print Name: "_$$GET1^DIQ(9999999.15,IEN,200)
- +13 SET T100=^AUTTEXAM(IEN,100)
- +14 SET OUTPUT(5)="Class: "_$$GET1^DIQ(9999999.15,IEN,100)
- +15 SET OUTPUT(6)="Sponsor: "_$$GET1^DIQ(9999999.15,IEN,101)
- +16 SET OUTPUT(7)="Sex Specific: "_$$GET1^DIQ(9999999.15,IEN,.03)
- +17 SET OUTPUT(8)="Inactive Flag: "_$$GET1^DIQ(9999999.15,IEN,.04)
- +18 SET OUTPUT(9)=""
- +19 SET OUTPUT(10)="Description:"
- +20 SET NL=10
- +21 SET TEMP=$$GET1^DIQ(9999999.15,IEN,201,"","WPARRAY")
- +22 IF TEMP=""
- SET NL=NL+1
- SET OUTPUT(NL)=""
- +23 IF TEMP="WPARRAY"
- Begin DoDot:1
- +24 SET IND=0
- +25 FOR
- SET IND=$ORDER(WPARRAY(IND))
- if IND=""
- QUIT
- SET NL=NL+1
- SET OUTPUT(NL)=WPARRAY(IND)
- +26 KILL WPARRAY
- End DoDot:1
- +27 ;
- +28 ;Mapped Codes.
- +29 SET IND=0
- +30 FOR
- SET IND=+$ORDER(^AUTTEXAM(IEN,210,IND))
- if IND=0
- QUIT
- Begin DoDot:1
- +31 SET TEMP=^AUTTEXAM(IEN,210,IND,0)
- +32 SET CODESYS=$PIECE(TEMP,U,1)
- SET CODE=$PIECE(TEMP,U,2)
- +33 SET MAPDT=$PIECE(TEMP,U,3)
- SET INDXDT=$PIECE(TEMP,U,4)
- +34 IF CODE'=""
- SET CODELIST(CODESYS,CODE)=MAPDT_U_INDXDT
- End DoDot:1
- +35 DO MCDISP^PXMCODES(.CODELIST,.NL,.OUTPUT)
- +36 ;
- +37 ;Deleted code mappings.
- +38 IF $PIECE($GET(^AUTTEXAM(IEN,230,0)),U,4)>0
- Begin DoDot:1
- +39 SET NL=NL+1
- SET OUTPUT(NL)=""
- +40 SET NL=NL+1
- SET OUTPUT(NL)=""
- +41 SET NL=NL+1
- SET OUTPUT(NL)="Deleted Code Mappings"
- +42 SET IND=0
- +43 FOR
- SET IND=+$ORDER(^AUTTEXAM(IEN,230,IND))
- if IND=0
- QUIT
- Begin DoDot:2
- +44 SET TEMP=^AUTTEXAM(IEN,230,IND,0)
- +45 SET NL=NL+1
- SET OUTPUT(NL)=""
- +46 SET NL=NL+1
- SET OUTPUT(NL)=" Coding System: "_$PIECE(TEMP,U,1)_" Code: "_$PIECE(TEMP,U,2)
- +47 SET NL=NL+1
- SET OUTPUT(NL)=" Date deleted: "_$$FMTE^XLFDT($PIECE(TEMP,U,3),"5Z")
- +48 SET OUTPUT(NL)=OUTPUT(NL)_" Deleted by: "_$$GET1^DIQ(200,$PIECE(TEMP,U,4),.01)
- +49 SET NL=NL+1
- SET OUTPUT(NL)=" Mapped Source Entry removal completion date: "_$$FMTE^XLFDT($PIECE(TEMP,U,5),"5Z")
- End DoDot:2
- +50 SET NL=NL+1
- SET OUTPUT(NL)=""
- End DoDot:1
- +51 ;
- +52 SET NL=NL+1
- SET OUTPUT(NL)=""
- +53 SET NL=NL+1
- SET OUTPUT(NL)=" Value Range"
- +54 SET TEMP=$GET(^AUTTEXAM(IEN,220))
- +55 IF TEMP=""
- SET NL=NL+1
- SET OUTPUT(NL)="Not defined"
- +56 IF '$TEST
- Begin DoDot:1
- +57 SET NL=NL+1
- SET OUTPUT(NL)=" Minimum Value Maximum Value UCUM Code"
- +58 SET NL=NL+1
- SET OUTPUT(NL)=$SELECT($EXTRACT(TEMP,1)="-":"",1:" ")_$PIECE(TEMP,U,1)
- +59 SET LEN=$LENGTH(OUTPUT(NL))
- SET NSP=30-LEN
- +60 SET OUTPUT(NL)=OUTPUT(NL)_$$REPEAT^XLFSTR(" ",NSP)_$PIECE(TEMP,U,2)
- +61 NEW UCUMDATA,UCUMIEN
- +62 SET UCUMIEN=+$PIECE(TEMP,U,4)
- +63 IF UCUMIEN>0
- Begin DoDot:2
- +64 ;ICR #6225
- +65 DO UCUMDATA^LEXMUCUM(UCUMIEN,.UCUMDATA)
- +66 SET LEN=$LENGTH(OUTPUT(NL))
- SET NSP=55-LEN
- +67 SET OUTPUT(NL)=OUTPUT(NL)_$$REPEAT^XLFSTR(" ",NSP)_UCUMDATA(UCUMIEN,"UCUM CODE")
- +68 SET NL=NL+1
- SET OUTPUT(NL)=""
- +69 SET NL=NL+1
- SET OUTPUT(NL)="UCUM Description: "_UCUMDATA(UCUMIEN,"DESCRIPTION")
- +70 SET NL=NL+1
- SET OUTPUT(NL)="Prompt Caption: "_$PIECE(TEMP,U,5)
- +71 SET NL=NL+1
- SET OUTPUT(NL)="UCUM Display: "_$$EXTERNAL^DILFD(9999999.15,225,"",$PIECE(TEMP,U,6))
- End DoDot:2
- End DoDot:1
- +72 QUIT
- +73 ;