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

PXEDUINQ.m

Go to the documentation of this file.
  1. PXEDUINQ ;SLC/PKR - Education Topic Inquire. ;03/21/2022
  1. ;;1.0;PCE PATIENT CARE ENCOUNTER;**211,217**;Aug 12, 1996;Build 134
  1. ;
  1. ;==========================================
  1. BEDUINQ(IEN) ;Display an Education Topic inquiry, defaults to the Browser.
  1. N BOP,DIR0,OUTPUT,TITLE,TYPE
  1. I '$D(^AUTTEDT(IEN)) Q
  1. S TITLE="Education Topic Inquiry"
  1. D EDUINQ(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. EDUINQ(IEN,OUTPUT) ;Education Topic inquiry, return the formatted text
  1. ;in OUTPUT.
  1. ;Use 80 column output.
  1. N CODE,CODELIST,CODESYS,INDXDT,MAPDT,NL,IENSTR,NSP,RM,SEQ,SUBT
  1. N TEMP,TEXT,WPARRAY
  1. S RM=80
  1. S TEMP=^AUTTEDT(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: "_$P(TEMP,U,4)
  1. S OUTPUT(5)="Class: "_$$GET1^DIQ(9999999.09,IEN,100)
  1. S OUTPUT(6)="Sponsor: "_$$GET1^DIQ(9999999.09,IEN,101)
  1. S OUTPUT(7)="Inactive Flag: "_$$GET1^DIQ(9999999.09,IEN,.03)
  1. S OUTPUT(8)=""
  1. S OUTPUT(9)="Description:"
  1. S NL=9
  1. S TEMP=$$GET1^DIQ(9999999.09,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. . S NL=NL+1,OUTPUT(NL)=""
  1. ;
  1. K TEMP,WPARRAY
  1. S NL=NL+1,OUTPUT(NL)=""
  1. S NL=NL+1,OUTPUT(NL)="Educational Outcome:"
  1. S TEMP=$$GET1^DIQ(9999999.09,IEN,11,"","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. . S NL=NL+1,OUTPUT(NL)=""
  1. ;
  1. K TEMP,WPARRAY
  1. S NL=NL+1,OUTPUT(NL)=""
  1. S NL=NL+1,OUTPUT(NL)="Educational Standards:"
  1. S TEMP=$$GET1^DIQ(9999999.09,IEN,12,"","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. . S NL=NL+1,OUTPUT(NL)=""
  1. ;
  1. ;Mapped Codes.
  1. S IND=0
  1. F S IND=+$O(^AUTTEDT(IEN,210,IND)) Q:IND=0 D
  1. . S TEMP=^AUTTEDT(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(^AUTTEDT(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(^AUTTEDT(IEN,230,IND)) Q:IND=0 D
  1. .. S TEMP=^AUTTEDT(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(^AUTTEDT(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=54-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.09,225,"",$P(TEMP,U,6))
  1. ;
  1. S NL=NL+1,OUTPUT(NL)=""
  1. S NL=NL+1,OUTPUT(NL)=" Subtopics"
  1. I +$P($G(^AUTTEDT(IEN,10,0)),U,4)=0 S NL=NL+1,OUTPUT(NL)=" None defined" Q
  1. S NL=NL+1,OUTPUT(NL)=" Seq Subtopic"
  1. S IND=0
  1. F S IND=+$O(^AUTTEDT(IEN,10,IND)) Q:IND=0 D
  1. . S TEMP=^AUTTEDT(IEN,10,IND,0)
  1. . S SUBT=$P(TEMP,U,1),SEQ=$P(TEMP,U,3)
  1. . S NL=NL+1,OUTPUT(NL)=$$RJ^XLFSTR(SEQ,4," ")_" "_$$GET1^DIQ(9999999.09,SUBT,.01)
  1. Q
  1. ;