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

PXEXINQ.m

Go to the documentation of this file.
  1. PXEXINQ ;SLC/PKR - Exam Inquire. ;03/21/2022
  1. ;;1.0;PCE PATIENT CARE ENCOUNTER;**211,217**;Aug 12, 1996;Build 134
  1. ;
  1. ;==========================================
  1. BEXINQ(IEN) ;Display an Exam inquiry, defaults to the Browser.
  1. N BOP,DIR0,OUTPUT,TITLE,TYPE
  1. I '$D(^AUTTEXAM(IEN)) Q
  1. S TITLE="Exam Inquiry"
  1. D EXINQ(IEN,.OUTPUT)
  1. S BOP=$$BORP^PXUTIL("B")
  1. I BOP="" Q
  1. I BOP="B" D BROWSE^DDBR("OUTPUT","NR",TITLE)
  1. I BOP="P" D GPRINT^PXUTIL("OUTPUT")
  1. Q
  1. ;
  1. ;==========================================
  1. EXINQ(IEN,OUTPUT) ;Exam inquiry, return the formatted text in OUTPUT.
  1. ;Use 80 column output.
  1. N CODE,CODELIST,CODESYS,IENSTR,IND,INDXDT,LEN,MAPDT
  1. N NL,NSP,RM,T100,TEMP,TEXT,WPARRAY
  1. S RM=80
  1. S TEMP=^AUTTEXAM(IEN,0)
  1. S IENSTR="No. "_IEN
  1. S OUTPUT(1)=$$REPEAT^XLFSTR("-",RM)
  1. S TEXT=$P(TEMP,U,1)
  1. S NSP=RM-$L(TEXT)-1
  1. S OUTPUT(2)=TEXT_$$RJ^XLFSTR(IENSTR,NSP," ")
  1. S OUTPUT(3)=$$REPEAT^XLFSTR("-",RM)
  1. S OUTPUT(4)="Print Name: "_$$GET1^DIQ(9999999.15,IEN,200)
  1. S T100=^AUTTEXAM(IEN,100)
  1. S OUTPUT(5)="Class: "_$$GET1^DIQ(9999999.15,IEN,100)
  1. S OUTPUT(6)="Sponsor: "_$$GET1^DIQ(9999999.15,IEN,101)
  1. S OUTPUT(7)="Sex Specific: "_$$GET1^DIQ(9999999.15,IEN,.03)
  1. S OUTPUT(8)="Inactive Flag: "_$$GET1^DIQ(9999999.15,IEN,.04)
  1. S OUTPUT(9)=""
  1. S OUTPUT(10)="Description:"
  1. S NL=10
  1. S TEMP=$$GET1^DIQ(9999999.15,IEN,201,"","WPARRAY")
  1. I TEMP="" S NL=NL+1,OUTPUT(NL)=""
  1. I TEMP="WPARRAY" D
  1. . S IND=0
  1. . F S IND=$O(WPARRAY(IND)) Q:IND="" S NL=NL+1,OUTPUT(NL)=WPARRAY(IND)
  1. . K WPARRAY
  1. ;
  1. ;Mapped Codes.
  1. S IND=0
  1. F S IND=+$O(^AUTTEXAM(IEN,210,IND)) Q:IND=0 D
  1. . S TEMP=^AUTTEXAM(IEN,210,IND,0)
  1. . S CODESYS=$P(TEMP,U,1),CODE=$P(TEMP,U,2)
  1. . S MAPDT=$P(TEMP,U,3),INDXDT=$P(TEMP,U,4)
  1. . I CODE'="" S CODELIST(CODESYS,CODE)=MAPDT_U_INDXDT
  1. D MCDISP^PXMCODES(.CODELIST,.NL,.OUTPUT)
  1. ;
  1. ;Deleted code mappings.
  1. I $P($G(^AUTTEXAM(IEN,230,0)),U,4)>0 D
  1. . S NL=NL+1,OUTPUT(NL)=""
  1. . S NL=NL+1,OUTPUT(NL)=""
  1. . S NL=NL+1,OUTPUT(NL)="Deleted Code Mappings"
  1. . S IND=0
  1. . F S IND=+$O(^AUTTEXAM(IEN,230,IND)) Q:IND=0 D
  1. .. S TEMP=^AUTTEXAM(IEN,230,IND,0)
  1. .. S NL=NL+1,OUTPUT(NL)=""
  1. .. S NL=NL+1,OUTPUT(NL)=" Coding System: "_$P(TEMP,U,1)_" Code: "_$P(TEMP,U,2)
  1. .. S NL=NL+1,OUTPUT(NL)=" Date deleted: "_$$FMTE^XLFDT($P(TEMP,U,3),"5Z")
  1. .. S OUTPUT(NL)=OUTPUT(NL)_" Deleted by: "_$$GET1^DIQ(200,$P(TEMP,U,4),.01)
  1. .. S NL=NL+1,OUTPUT(NL)=" Mapped Source Entry removal completion date: "_$$FMTE^XLFDT($P(TEMP,U,5),"5Z")
  1. . S NL=NL+1,OUTPUT(NL)=""
  1. ;
  1. S NL=NL+1,OUTPUT(NL)=""
  1. S NL=NL+1,OUTPUT(NL)=" Value Range"
  1. S TEMP=$G(^AUTTEXAM(IEN,220))
  1. I TEMP="" S NL=NL+1,OUTPUT(NL)="Not defined"
  1. E D
  1. . S NL=NL+1,OUTPUT(NL)=" Minimum Value Maximum Value UCUM Code"
  1. . S NL=NL+1,OUTPUT(NL)=$S($E(TEMP,1)="-":"",1:" ")_$P(TEMP,U,1)
  1. . S LEN=$L(OUTPUT(NL)),NSP=30-LEN
  1. . S OUTPUT(NL)=OUTPUT(NL)_$$REPEAT^XLFSTR(" ",NSP)_$P(TEMP,U,2)
  1. . N UCUMDATA,UCUMIEN
  1. . S UCUMIEN=+$P(TEMP,U,4)
  1. . I UCUMIEN>0 D
  1. ..;ICR #6225
  1. .. D UCUMDATA^LEXMUCUM(UCUMIEN,.UCUMDATA)
  1. .. S LEN=$L(OUTPUT(NL)),NSP=55-LEN
  1. .. S OUTPUT(NL)=OUTPUT(NL)_$$REPEAT^XLFSTR(" ",NSP)_UCUMDATA(UCUMIEN,"UCUM CODE")
  1. .. S NL=NL+1,OUTPUT(NL)=""
  1. .. S NL=NL+1,OUTPUT(NL)="UCUM Description: "_UCUMDATA(UCUMIEN,"DESCRIPTION")
  1. .. S NL=NL+1,OUTPUT(NL)="Prompt Caption: "_$P(TEMP,U,5)
  1. .. S NL=NL+1,OUTPUT(NL)="UCUM Display: "_$$EXTERNAL^DILFD(9999999.15,225,"",$P(TEMP,U,6))
  1. Q
  1. ;