- PXEDUINQ ;SLC/PKR - Education Topic Inquire. ;03/21/2022
- ;;1.0;PCE PATIENT CARE ENCOUNTER;**211,217**;Aug 12, 1996;Build 134
- ;
- ;==========================================
- BEDUINQ(IEN) ;Display an Education Topic inquiry, defaults to the Browser.
- N BOP,DIR0,OUTPUT,TITLE,TYPE
- I '$D(^AUTTEDT(IEN)) Q
- S TITLE="Education Topic Inquiry"
- D EDUINQ(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
- ;
- ;==========================================
- EDUINQ(IEN,OUTPUT) ;Education Topic inquiry, return the formatted text
- ;in OUTPUT.
- ;Use 80 column output.
- N CODE,CODELIST,CODESYS,INDXDT,MAPDT,NL,IENSTR,NSP,RM,SEQ,SUBT
- N TEMP,TEXT,WPARRAY
- S RM=80
- S TEMP=^AUTTEDT(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: "_$P(TEMP,U,4)
- S OUTPUT(5)="Class: "_$$GET1^DIQ(9999999.09,IEN,100)
- S OUTPUT(6)="Sponsor: "_$$GET1^DIQ(9999999.09,IEN,101)
- S OUTPUT(7)="Inactive Flag: "_$$GET1^DIQ(9999999.09,IEN,.03)
- S OUTPUT(8)=""
- S OUTPUT(9)="Description:"
- S NL=9
- S TEMP=$$GET1^DIQ(9999999.09,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
- . S NL=NL+1,OUTPUT(NL)=""
- ;
- K TEMP,WPARRAY
- S NL=NL+1,OUTPUT(NL)=""
- S NL=NL+1,OUTPUT(NL)="Educational Outcome:"
- S TEMP=$$GET1^DIQ(9999999.09,IEN,11,"","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
- . S NL=NL+1,OUTPUT(NL)=""
- ;
- K TEMP,WPARRAY
- S NL=NL+1,OUTPUT(NL)=""
- S NL=NL+1,OUTPUT(NL)="Educational Standards:"
- S TEMP=$$GET1^DIQ(9999999.09,IEN,12,"","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
- . S NL=NL+1,OUTPUT(NL)=""
- ;
- ;Mapped Codes.
- S IND=0
- F S IND=+$O(^AUTTEDT(IEN,210,IND)) Q:IND=0 D
- . S TEMP=^AUTTEDT(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(^AUTTEDT(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(^AUTTEDT(IEN,230,IND)) Q:IND=0 D
- .. S TEMP=^AUTTEDT(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(^AUTTEDT(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=54-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.09,225,"",$P(TEMP,U,6))
- ;
- S NL=NL+1,OUTPUT(NL)=""
- S NL=NL+1,OUTPUT(NL)=" Subtopics"
- I +$P($G(^AUTTEDT(IEN,10,0)),U,4)=0 S NL=NL+1,OUTPUT(NL)=" None defined" Q
- S NL=NL+1,OUTPUT(NL)=" Seq Subtopic"
- S IND=0
- F S IND=+$O(^AUTTEDT(IEN,10,IND)) Q:IND=0 D
- . S TEMP=^AUTTEDT(IEN,10,IND,0)
- . S SUBT=$P(TEMP,U,1),SEQ=$P(TEMP,U,3)
- . S NL=NL+1,OUTPUT(NL)=$$RJ^XLFSTR(SEQ,4," ")_" "_$$GET1^DIQ(9999999.09,SUBT,.01)
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXEDUINQ 4485 printed Feb 18, 2025@23:55:03 Page 2
- PXEDUINQ ;SLC/PKR - Education Topic Inquire. ;03/21/2022
- +1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**211,217**;Aug 12, 1996;Build 134
- +2 ;
- +3 ;==========================================
- BEDUINQ(IEN) ;Display an Education Topic inquiry, defaults to the Browser.
- +1 NEW BOP,DIR0,OUTPUT,TITLE,TYPE
- +2 IF '$DATA(^AUTTEDT(IEN))
- QUIT
- +3 SET TITLE="Education Topic Inquiry"
- +4 DO EDUINQ(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 ;==========================================
- EDUINQ(IEN,OUTPUT) ;Education Topic inquiry, return the formatted text
- +1 ;in OUTPUT.
- +2 ;Use 80 column output.
- +3 NEW CODE,CODELIST,CODESYS,INDXDT,MAPDT,NL,IENSTR,NSP,RM,SEQ,SUBT
- +4 NEW TEMP,TEXT,WPARRAY
- +5 SET RM=80
- +6 SET TEMP=^AUTTEDT(IEN,0)
- +7 SET IENSTR="No. "_IEN
- +8 SET OUTPUT(1)=$$REPEAT^XLFSTR("-",RM)
- +9 SET TEXT=$PIECE(TEMP,U,1)
- +10 SET NSP=RM-$LENGTH(TEXT)-1
- +11 SET OUTPUT(2)=TEXT_$$RJ^XLFSTR(IENSTR,NSP," ")
- +12 SET OUTPUT(3)=$$REPEAT^XLFSTR("-",RM)
- +13 SET OUTPUT(4)="Print Name: "_$PIECE(TEMP,U,4)
- +14 SET OUTPUT(5)="Class: "_$$GET1^DIQ(9999999.09,IEN,100)
- +15 SET OUTPUT(6)="Sponsor: "_$$GET1^DIQ(9999999.09,IEN,101)
- +16 SET OUTPUT(7)="Inactive Flag: "_$$GET1^DIQ(9999999.09,IEN,.03)
- +17 SET OUTPUT(8)=""
- +18 SET OUTPUT(9)="Description:"
- +19 SET NL=9
- +20 SET TEMP=$$GET1^DIQ(9999999.09,IEN,201,"","WPARRAY")
- +21 IF TEMP=""
- SET NL=NL+1
- SET OUTPUT(NL)=""
- +22 IF TEMP="WPARRAY"
- Begin DoDot:1
- +23 SET IND=0
- +24 FOR
- SET IND=$ORDER(WPARRAY(IND))
- if IND=""
- QUIT
- SET NL=NL+1
- SET OUTPUT(NL)=WPARRAY(IND)
- +25 KILL WPARRAY
- +26 SET NL=NL+1
- SET OUTPUT(NL)=""
- End DoDot:1
- +27 ;
- +28 KILL TEMP,WPARRAY
- +29 SET NL=NL+1
- SET OUTPUT(NL)=""
- +30 SET NL=NL+1
- SET OUTPUT(NL)="Educational Outcome:"
- +31 SET TEMP=$$GET1^DIQ(9999999.09,IEN,11,"","WPARRAY")
- +32 IF TEMP=""
- SET NL=NL+1
- SET OUTPUT(NL)=""
- +33 IF TEMP="WPARRAY"
- Begin DoDot:1
- +34 SET IND=0
- +35 FOR
- SET IND=$ORDER(WPARRAY(IND))
- if IND=""
- QUIT
- SET NL=NL+1
- SET OUTPUT(NL)=WPARRAY(IND)
- +36 KILL WPARRAY
- +37 SET NL=NL+1
- SET OUTPUT(NL)=""
- End DoDot:1
- +38 ;
- +39 KILL TEMP,WPARRAY
- +40 SET NL=NL+1
- SET OUTPUT(NL)=""
- +41 SET NL=NL+1
- SET OUTPUT(NL)="Educational Standards:"
- +42 SET TEMP=$$GET1^DIQ(9999999.09,IEN,12,"","WPARRAY")
- +43 IF TEMP=""
- SET NL=NL+1
- SET OUTPUT(NL)=""
- +44 IF TEMP="WPARRAY"
- Begin DoDot:1
- +45 SET IND=0
- +46 FOR
- SET IND=$ORDER(WPARRAY(IND))
- if IND=""
- QUIT
- SET NL=NL+1
- SET OUTPUT(NL)=WPARRAY(IND)
- +47 KILL WPARRAY
- +48 SET NL=NL+1
- SET OUTPUT(NL)=""
- End DoDot:1
- +49 ;
- +50 ;Mapped Codes.
- +51 SET IND=0
- +52 FOR
- SET IND=+$ORDER(^AUTTEDT(IEN,210,IND))
- if IND=0
- QUIT
- Begin DoDot:1
- +53 SET TEMP=^AUTTEDT(IEN,210,IND,0)
- +54 SET CODESYS=$PIECE(TEMP,U,1)
- SET CODE=$PIECE(TEMP,U,2)
- +55 SET MAPDT=$PIECE(TEMP,U,3)
- SET INDXDT=$PIECE(TEMP,U,4)
- +56 IF CODE'=""
- SET CODELIST(CODESYS,CODE)=MAPDT_U_INDXDT
- End DoDot:1
- +57 DO MCDISP^PXMCODES(.CODELIST,.NL,.OUTPUT)
- +58 ;
- +59 ;Deleted code mappings.
- +60 IF $PIECE($GET(^AUTTEDT(IEN,230,0)),U,4)>0
- Begin DoDot:1
- +61 SET NL=NL+1
- SET OUTPUT(NL)=""
- +62 SET NL=NL+1
- SET OUTPUT(NL)=""
- +63 SET NL=NL+1
- SET OUTPUT(NL)="Deleted Code Mappings"
- +64 SET IND=0
- +65 FOR
- SET IND=+$ORDER(^AUTTEDT(IEN,230,IND))
- if IND=0
- QUIT
- Begin DoDot:2
- +66 SET TEMP=^AUTTEDT(IEN,230,IND,0)
- +67 SET NL=NL+1
- SET OUTPUT(NL)=""
- +68 SET NL=NL+1
- SET OUTPUT(NL)=" Coding System: "_$PIECE(TEMP,U,1)_" Code: "_$PIECE(TEMP,U,2)
- +69 SET NL=NL+1
- SET OUTPUT(NL)=" Date deleted: "_$$FMTE^XLFDT($PIECE(TEMP,U,3),"5Z")
- +70 SET OUTPUT(NL)=OUTPUT(NL)_" Deleted by: "_$$GET1^DIQ(200,$PIECE(TEMP,U,4),.01)
- +71 SET NL=NL+1
- SET OUTPUT(NL)=" Mapped Source Entry removal completion date: "_$$FMTE^XLFDT($PIECE(TEMP,U,5),"5Z")
- End DoDot:2
- +72 SET NL=NL+1
- SET OUTPUT(NL)=""
- End DoDot:1
- +73 ;
- +74 SET NL=NL+1
- SET OUTPUT(NL)=""
- +75 SET NL=NL+1
- SET OUTPUT(NL)=" Value Range"
- +76 SET TEMP=$GET(^AUTTEDT(IEN,220))
- +77 IF TEMP=""
- SET NL=NL+1
- SET OUTPUT(NL)="Not defined"
- +78 IF '$TEST
- Begin DoDot:1
- +79 SET NL=NL+1
- SET OUTPUT(NL)=" Minimum Value Maximum Value UCUM Code"
- +80 SET NL=NL+1
- SET OUTPUT(NL)=$SELECT($EXTRACT(TEMP,1)="-":"",1:" ")_$PIECE(TEMP,U,1)
- +81 SET LEN=$LENGTH(OUTPUT(NL))
- SET NSP=30-LEN
- +82 SET OUTPUT(NL)=OUTPUT(NL)_$$REPEAT^XLFSTR(" ",NSP)_$PIECE(TEMP,U,2)
- +83 NEW UCUMDATA,UCUMIEN
- +84 SET UCUMIEN=+$PIECE(TEMP,U,4)
- +85 IF UCUMIEN>0
- Begin DoDot:2
- +86 ;ICR #6225
- +87 DO UCUMDATA^LEXMUCUM(UCUMIEN,.UCUMDATA)
- +88 SET LEN=$LENGTH(OUTPUT(NL))
- SET NSP=54-LEN
- +89 SET OUTPUT(NL)=OUTPUT(NL)_$$REPEAT^XLFSTR(" ",NSP)_UCUMDATA(UCUMIEN,"UCUM CODE")
- +90 SET NL=NL+1
- SET OUTPUT(NL)=""
- +91 SET NL=NL+1
- SET OUTPUT(NL)="UCUM Description: "_UCUMDATA(UCUMIEN,"DESCRIPTION")
- +92 SET NL=NL+1
- SET OUTPUT(NL)="Prompt Caption: "_$PIECE(TEMP,U,5)
- +93 SET NL=NL+1
- SET OUTPUT(NL)="UCUM Display: "_$$EXTERNAL^DILFD(9999999.09,225,"",$PIECE(TEMP,U,6))
- End DoDot:2
- End DoDot:1
- +94 ;
- +95 SET NL=NL+1
- SET OUTPUT(NL)=""
- +96 SET NL=NL+1
- SET OUTPUT(NL)=" Subtopics"
- +97 IF +$PIECE($GET(^AUTTEDT(IEN,10,0)),U,4)=0
- SET NL=NL+1
- SET OUTPUT(NL)=" None defined"
- QUIT
- +98 SET NL=NL+1
- SET OUTPUT(NL)=" Seq Subtopic"
- +99 SET IND=0
- +100 FOR
- SET IND=+$ORDER(^AUTTEDT(IEN,10,IND))
- if IND=0
- QUIT
- Begin DoDot:1
- +101 SET TEMP=^AUTTEDT(IEN,10,IND,0)
- +102 SET SUBT=$PIECE(TEMP,U,1)
- SET SEQ=$PIECE(TEMP,U,3)
- +103 SET NL=NL+1
- SET OUTPUT(NL)=$$RJ^XLFSTR(SEQ,4," ")_" "_$$GET1^DIQ(9999999.09,SUBT,.01)
- End DoDot:1
- +104 QUIT
- +105 ;