PXCESC ;SLC/PKR - Used to edit and display V STANDARD CODES ;12/15/2020
;;1.0;PCE PATIENT CARE ENCOUNTER;**211**;Aug 12, 1996;Build 454
;
;Reference to LEXU supported by ICR #5679.
;
Q
;
;Line with the line label "FORMAT"
;;Long name~File Number~Node Subscripts~Allow Duplicate entries (1=yes, 0=no)~File global name
; 1 2 3 4 5
;
;Following lines:
;;Node~Piece~,Field Number~Edit Label~Display Label~Display Routine~Edit Routine~Help Text for DIR(?)~Set of PXCEKEYS that can Edit~D if Detail Display Only~
; 1 ~ 2 ~ 3 ~ 4 ~ 5 ~ 6 ~ 7 ~ 8 ~ 9 ~ 10
;The Display & Edit routines are for special cases.
; (The .01 field cannot have a special edit.)
;
FORMAT ;;Standard Codes~9000010.71~0,12,220,300,811,812~1~^AUPNVSC
;;0~5~.05~Coding System:~Coding System: ~$$DISCSYS^PXCESC~SKIP^PXCESC~~~
;;0~1~.01~Code: ~Code: ~$$DISPLY01^PXCESC~EDITCODE^PXCESC(PXCEFIEN,PXCEVIEN)~^D HELP^PXCEHELP~~
;;12~1~1201~Event Date and Time: ~Event Date and Time: ~~~~~D
;;220~1~220~Magnitude: ~Magnitude: ~~SKIP^PXCESC~~~D
;;220~2~221~UCUM Code: ~UCUM Description: ~~SKIP^PXCESC~~~D
;;300~1~300~Mapped Source: ~Mapped Source: ~$$DISMAPS^PXCESC~SKIP^PXCESC~~~B
;;811~1~81101~Comments: ~Comments: ~~SKIP^PXCESC~~~D
;;812~2~81202~Package: ~Package: ~~SKIP^PXCESC~~~D
;;812~3~81203~Data Source: ~Data Source: ~~SKIP^PXCESC~~~D
;;
;================================
ADDCODE(VISITIEN,VSCIEN) ;Let the user select and add codes.
N CODE,CODESYS,EVENTDT,FDA,FDAIEN,HELP,MSG,PXCEDT,SERVCAT,SRCHTERM,TEMP
;Setting PXCELOOP=1 causes ADDCODE to exit.
;Have the user select the coding system.
S CODESYS=$$GETCSYS^PXLEX(0)
I CODESYS="" S PXCELOOP=1 Q
;Prompt the user for the Lexicon search term.
S SRCHTERM=$$GETST^PXLEX
I SRCHTERM="" S PXCELOOP=1 Q
;Prompt the user for the Event Date and Time. This is only
;for new entries because it is used in the Lexicon search
;to ensure only codes active on that date are returned.
S HELP="D EVDTHELP^PXCESC"
S TEMP=^AUPNVSIT(VISITIEN,0)
S SERVCAT=$P(TEMP,U,7)
S EVENTDT=$$EVENTDT^PXDATE("",HELP)
S PXCEDT=EVENTDT
I PXCEDT="" S PXCEDT=$P(TEMP,U,1)
;Let the user select the code(s), only return active codes.
S CODE=$$GETCODE^PXLEXS(CODESYS,SRCHTERM,PXCEDT,1)
I CODE="" S PXCELOOP=1 Q
S FDA(9000010.71,"+1,",.01)=CODE
S FDA(9000010.71,"+1,",.02)=DFN
S FDA(9000010.71,"+1,",.03)=VISITIEN
S FDA(9000010.71,"+1,",.05)=CODESYS
S FDA(9000010.71,"+1,",1201)=EVENTDT
D UPDATE^DIE("","FDA","FDAIEN","MSG")
I $D(MSG) D Q
. N SUBJECT
. S SUBJECT="V STANDARD CODES entry failed for "_CODELIST(IND)_"."
. D SENDEMSG^PXMCLINK(SUBJECT,.MSG)
.;If this is being called from List Manager display the error on
.;the screen.
. I $D(VALMCC) D ERRORLM^PXKMCODE(SUBJECT,.MSG)
. S PXCELOOP=1
S VSCIEN=FDAIEN(1)
S ^TMP("PXK",$J,"SC",1,"IEN")=FDAIEN(1)
S ^TMP("PXK",$J,"SC",1,0,"AFTER")=^AUPNVSC(FDAIEN(1),0)
S ^TMP("PXK",$J,"SC",1,12,"AFTER")=$G(^AUPNVSC(FDAIEN(1),12))
S ^TMP("PXK",$J,"SC",1,220,"AFTER")=$G(^AUPNVSC(FDAIEN(1),220))
S ^TMP("PXK",$J,"SC",1,300,"AFTER")=$G(^AUPNVSC(FDAIEN(1),300))
S ^TMP("PXK",$J,"SC",1,801,"AFTER")=$G(^AUPNVSC(FDAIEN(1),801))
S ^TMP("PXK",$J,"SC",1,811,"AFTER")=$G(^AUPNVSC(FDAIEN(1),811))
S ^TMP("PXK",$J,"SC",1,812,"AFTER")=$G(^AUPNVSC(FDAIEN(1),812))
S ^TMP("PXK",$J,"SC",1,0,"BEFORE")=""
S ^TMP("PXK",$J,"SC",1,12,"BEFORE")=""
S ^TMP("PXK",$J,"SC",1,220,"BEFORE")=""
S ^TMP("PXK",$J,"SC",1,300,"BEFORE")=""
S ^TMP("PXK",$J,"SC",1,801,"BEFORE")=""
S ^TMP("PXK",$J,"SC",1,811,"BEFORE")=""
S ^TMP("PXK",$J,"SC",1,812,"BEFORE")=""
Q
;
;================================
DISMAPS(PXCEEXT,PXCEDT) ;If the Mapped Source exists, display the information.
;The argument is appended to the call in the FORMAT line by PXCEAE1.
I PXCEEXT="" Q
N ENTRY,FILENAM,FILENUM,IENS
S FILENUM=$P(PXCEEXT,";",1)
S IENS=$P(PXCEEXT,";",2)_","
S FILENAME=$$GET1^DID(FILENUM,"","","NAME")
S ENTRY=$$GET1^DIQ(FILENUM,IENS,.01)
S TEXT=FILENAME_": "_ENTRY
Q FILENAME_" - "_ENTRY
;
;********************************
DISCSYS(PXCESC,PXCEDT) ;Display the coding system
;DBIA #5679
Q $P($$CSYS^LEXU(PXCESC),U,4)
;
;********************************
DISPLY01(PXCESC,PXCEDT) ;Display the code.
;The argument is appended to the call in the FORMAT line by PXCEAE1.
N CODE,CODESYS,DATA,DATE,FSN,RESULT,TEXT
S CODE=$P(PXCESC,U,1),CODESYS=$P(PXCESC,U,5)
S TEXT=CODE_" ("_CODESYS_")"
;DBIA #5679
S RESULT=$$CSDATA^LEXU(CODE,CODESYS,PXCEDT,.DATA)
I RESULT=1 D
. S FSN=$P(DATA("LEX",4),U,2)
. I FSN="" S FSN=$P(DATA("LEX",3),U,2)
. S TEXT=TEXT_" "_FSN
Q TEXT
;
;********************************
EDITCODE(VSCIEN,VISITIEN) ;Edit the code.
;If VSCIEN is null then this is an add.
I VSCIEN="" D ADDCODE(VISITIEN,.VSCIEN)
I PXCELOOP=1 Q
;Start the ScreenMan editor
D SMANEDIT^PXVSCSM(VSCIEN)
S PXCEAFTR(0)=^AUPNVSC(VSCIEN,0)
S PXCEAFTR(12)=$G(^AUPNVSC(VSCIEN,12))
S PXCEAFTR(220)=$G(^AUPNVSC(VSCIEN,220))
S PXCEAFTR(300)=$G(^AUPNVSC(VSCIEN,300))
S PXCEAFTR(801)=$G(^AUPNVSC(VSCIEN,801))
S PXCEAFTR(811)=$G(^AUPNVSC(VSCIEN,811))
S PXCEAFTR(812)=$G(^AUPNVSC(VSCIEN,812))
Q
;
;********************************
EVDTHELP ;Event Date and Time help.
N ERR,RESULT,TEXT
S RESULT=$$GET1^DID(9000010.71,1201,"","DESCRIPTION","TEXT","ERR")
D BROWSE^DDBR("TEXT(""DESCRIPTION"")","NR","V Standard Codes Event Date and Time Help")
I $D(DDS) D REFRESH^DDSUTL S DY=IOSL-7,DX=0 X IOXY S $Y=DY,$X=DX
Q
;
;********************************
SKIP ;Used to by-pass roll and scroll editing of a field.
S (X,Y)=""
Q
;
;********************************
VSCDATE(VIEN,VSCZNODE) ;If the EVENT D/T exists return it, otherwise
;return the VISIT/ADMIT DATE&TIME.
N DATE,IEN,VSCIEN,ZN
S (IEN,VSCIEN)=0
F S IEN=+$O(^AUPNVSC("AD",VIEN,IEN)) Q:(VSCIEN>0)!(IEN=0) D
. S ZN=^AUPNVSC(IEN,0)
. I ZN=VSCZNODE S VSCIEN=IEN Q
S DATE=$P($G(^AUPNVSC(VSCIEN,12)),U,1)
I DATE="" S DATE=$P(^AUPNVSIT(VIEN,0),U,1)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXCESC 6204 printed Nov 22, 2024@17:38:13 Page 2
PXCESC ;SLC/PKR - Used to edit and display V STANDARD CODES ;12/15/2020
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**211**;Aug 12, 1996;Build 454
+2 ;
+3 ;Reference to LEXU supported by ICR #5679.
+4 ;
+5 QUIT
+6 ;
+7 ;Line with the line label "FORMAT"
+8 ;;Long name~File Number~Node Subscripts~Allow Duplicate entries (1=yes, 0=no)~File global name
+9 ; 1 2 3 4 5
+10 ;
+11 ;Following lines:
+12 ;;Node~Piece~,Field Number~Edit Label~Display Label~Display Routine~Edit Routine~Help Text for DIR(?)~Set of PXCEKEYS that can Edit~D if Detail Display Only~
+13 ; 1 ~ 2 ~ 3 ~ 4 ~ 5 ~ 6 ~ 7 ~ 8 ~ 9 ~ 10
+14 ;The Display & Edit routines are for special cases.
+15 ; (The .01 field cannot have a special edit.)
+16 ;
FORMAT ;;Standard Codes~9000010.71~0,12,220,300,811,812~1~^AUPNVSC
+1 ;;0~5~.05~Coding System:~Coding System: ~$$DISCSYS^PXCESC~SKIP^PXCESC~~~
+2 ;;0~1~.01~Code: ~Code: ~$$DISPLY01^PXCESC~EDITCODE^PXCESC(PXCEFIEN,PXCEVIEN)~^D HELP^PXCEHELP~~
+3 ;;12~1~1201~Event Date and Time: ~Event Date and Time: ~~~~~D
+4 ;;220~1~220~Magnitude: ~Magnitude: ~~SKIP^PXCESC~~~D
+5 ;;220~2~221~UCUM Code: ~UCUM Description: ~~SKIP^PXCESC~~~D
+6 ;;300~1~300~Mapped Source: ~Mapped Source: ~$$DISMAPS^PXCESC~SKIP^PXCESC~~~B
+7 ;;811~1~81101~Comments: ~Comments: ~~SKIP^PXCESC~~~D
+8 ;;812~2~81202~Package: ~Package: ~~SKIP^PXCESC~~~D
+9 ;;812~3~81203~Data Source: ~Data Source: ~~SKIP^PXCESC~~~D
+10 ;;
+11 ;================================
ADDCODE(VISITIEN,VSCIEN) ;Let the user select and add codes.
+1 NEW CODE,CODESYS,EVENTDT,FDA,FDAIEN,HELP,MSG,PXCEDT,SERVCAT,SRCHTERM,TEMP
+2 ;Setting PXCELOOP=1 causes ADDCODE to exit.
+3 ;Have the user select the coding system.
+4 SET CODESYS=$$GETCSYS^PXLEX(0)
+5 IF CODESYS=""
SET PXCELOOP=1
QUIT
+6 ;Prompt the user for the Lexicon search term.
+7 SET SRCHTERM=$$GETST^PXLEX
+8 IF SRCHTERM=""
SET PXCELOOP=1
QUIT
+9 ;Prompt the user for the Event Date and Time. This is only
+10 ;for new entries because it is used in the Lexicon search
+11 ;to ensure only codes active on that date are returned.
+12 SET HELP="D EVDTHELP^PXCESC"
+13 SET TEMP=^AUPNVSIT(VISITIEN,0)
+14 SET SERVCAT=$PIECE(TEMP,U,7)
+15 SET EVENTDT=$$EVENTDT^PXDATE("",HELP)
+16 SET PXCEDT=EVENTDT
+17 IF PXCEDT=""
SET PXCEDT=$PIECE(TEMP,U,1)
+18 ;Let the user select the code(s), only return active codes.
+19 SET CODE=$$GETCODE^PXLEXS(CODESYS,SRCHTERM,PXCEDT,1)
+20 IF CODE=""
SET PXCELOOP=1
QUIT
+21 SET FDA(9000010.71,"+1,",.01)=CODE
+22 SET FDA(9000010.71,"+1,",.02)=DFN
+23 SET FDA(9000010.71,"+1,",.03)=VISITIEN
+24 SET FDA(9000010.71,"+1,",.05)=CODESYS
+25 SET FDA(9000010.71,"+1,",1201)=EVENTDT
+26 DO UPDATE^DIE("","FDA","FDAIEN","MSG")
+27 IF $DATA(MSG)
Begin DoDot:1
+28 NEW SUBJECT
+29 SET SUBJECT="V STANDARD CODES entry failed for "_CODELIST(IND)_"."
+30 DO SENDEMSG^PXMCLINK(SUBJECT,.MSG)
+31 ;If this is being called from List Manager display the error on
+32 ;the screen.
+33 IF $DATA(VALMCC)
DO ERRORLM^PXKMCODE(SUBJECT,.MSG)
+34 SET PXCELOOP=1
End DoDot:1
QUIT
+35 SET VSCIEN=FDAIEN(1)
+36 SET ^TMP("PXK",$JOB,"SC",1,"IEN")=FDAIEN(1)
+37 SET ^TMP("PXK",$JOB,"SC",1,0,"AFTER")=^AUPNVSC(FDAIEN(1),0)
+38 SET ^TMP("PXK",$JOB,"SC",1,12,"AFTER")=$GET(^AUPNVSC(FDAIEN(1),12))
+39 SET ^TMP("PXK",$JOB,"SC",1,220,"AFTER")=$GET(^AUPNVSC(FDAIEN(1),220))
+40 SET ^TMP("PXK",$JOB,"SC",1,300,"AFTER")=$GET(^AUPNVSC(FDAIEN(1),300))
+41 SET ^TMP("PXK",$JOB,"SC",1,801,"AFTER")=$GET(^AUPNVSC(FDAIEN(1),801))
+42 SET ^TMP("PXK",$JOB,"SC",1,811,"AFTER")=$GET(^AUPNVSC(FDAIEN(1),811))
+43 SET ^TMP("PXK",$JOB,"SC",1,812,"AFTER")=$GET(^AUPNVSC(FDAIEN(1),812))
+44 SET ^TMP("PXK",$JOB,"SC",1,0,"BEFORE")=""
+45 SET ^TMP("PXK",$JOB,"SC",1,12,"BEFORE")=""
+46 SET ^TMP("PXK",$JOB,"SC",1,220,"BEFORE")=""
+47 SET ^TMP("PXK",$JOB,"SC",1,300,"BEFORE")=""
+48 SET ^TMP("PXK",$JOB,"SC",1,801,"BEFORE")=""
+49 SET ^TMP("PXK",$JOB,"SC",1,811,"BEFORE")=""
+50 SET ^TMP("PXK",$JOB,"SC",1,812,"BEFORE")=""
+51 QUIT
+52 ;
+53 ;================================
DISMAPS(PXCEEXT,PXCEDT) ;If the Mapped Source exists, display the information.
+1 ;The argument is appended to the call in the FORMAT line by PXCEAE1.
+2 IF PXCEEXT=""
QUIT
+3 NEW ENTRY,FILENAM,FILENUM,IENS
+4 SET FILENUM=$PIECE(PXCEEXT,";",1)
+5 SET IENS=$PIECE(PXCEEXT,";",2)_","
+6 SET FILENAME=$$GET1^DID(FILENUM,"","","NAME")
+7 SET ENTRY=$$GET1^DIQ(FILENUM,IENS,.01)
+8 SET TEXT=FILENAME_": "_ENTRY
+9 QUIT FILENAME_" - "_ENTRY
+10 ;
+11 ;********************************
DISCSYS(PXCESC,PXCEDT) ;Display the coding system
+1 ;DBIA #5679
+2 QUIT $PIECE($$CSYS^LEXU(PXCESC),U,4)
+3 ;
+4 ;********************************
DISPLY01(PXCESC,PXCEDT) ;Display the code.
+1 ;The argument is appended to the call in the FORMAT line by PXCEAE1.
+2 NEW CODE,CODESYS,DATA,DATE,FSN,RESULT,TEXT
+3 SET CODE=$PIECE(PXCESC,U,1)
SET CODESYS=$PIECE(PXCESC,U,5)
+4 SET TEXT=CODE_" ("_CODESYS_")"
+5 ;DBIA #5679
+6 SET RESULT=$$CSDATA^LEXU(CODE,CODESYS,PXCEDT,.DATA)
+7 IF RESULT=1
Begin DoDot:1
+8 SET FSN=$PIECE(DATA("LEX",4),U,2)
+9 IF FSN=""
SET FSN=$PIECE(DATA("LEX",3),U,2)
+10 SET TEXT=TEXT_" "_FSN
End DoDot:1
+11 QUIT TEXT
+12 ;
+13 ;********************************
EDITCODE(VSCIEN,VISITIEN) ;Edit the code.
+1 ;If VSCIEN is null then this is an add.
+2 IF VSCIEN=""
DO ADDCODE(VISITIEN,.VSCIEN)
+3 IF PXCELOOP=1
QUIT
+4 ;Start the ScreenMan editor
+5 DO SMANEDIT^PXVSCSM(VSCIEN)
+6 SET PXCEAFTR(0)=^AUPNVSC(VSCIEN,0)
+7 SET PXCEAFTR(12)=$GET(^AUPNVSC(VSCIEN,12))
+8 SET PXCEAFTR(220)=$GET(^AUPNVSC(VSCIEN,220))
+9 SET PXCEAFTR(300)=$GET(^AUPNVSC(VSCIEN,300))
+10 SET PXCEAFTR(801)=$GET(^AUPNVSC(VSCIEN,801))
+11 SET PXCEAFTR(811)=$GET(^AUPNVSC(VSCIEN,811))
+12 SET PXCEAFTR(812)=$GET(^AUPNVSC(VSCIEN,812))
+13 QUIT
+14 ;
+15 ;********************************
EVDTHELP ;Event Date and Time help.
+1 NEW ERR,RESULT,TEXT
+2 SET RESULT=$$GET1^DID(9000010.71,1201,"","DESCRIPTION","TEXT","ERR")
+3 DO BROWSE^DDBR("TEXT(""DESCRIPTION"")","NR","V Standard Codes Event Date and Time Help")
+4 IF $DATA(DDS)
DO REFRESH^DDSUTL
SET DY=IOSL-7
SET DX=0
XECUTE IOXY
SET $Y=DY
SET $X=DX
+5 QUIT
+6 ;
+7 ;********************************
SKIP ;Used to by-pass roll and scroll editing of a field.
+1 SET (X,Y)=""
+2 QUIT
+3 ;
+4 ;********************************
VSCDATE(VIEN,VSCZNODE) ;If the EVENT D/T exists return it, otherwise
+1 ;return the VISIT/ADMIT DATE&TIME.
+2 NEW DATE,IEN,VSCIEN,ZN
+3 SET (IEN,VSCIEN)=0
+4 FOR
SET IEN=+$ORDER(^AUPNVSC("AD",VIEN,IEN))
if (VSCIEN>0)!(IEN=0)
QUIT
Begin DoDot:1
+5 SET ZN=^AUPNVSC(IEN,0)
+6 IF ZN=VSCZNODE
SET VSCIEN=IEN
QUIT
End DoDot:1
+7 SET DATE=$PIECE($GET(^AUPNVSC(VSCIEN,12)),U,1)
+8 IF DATE=""
SET DATE=$PIECE(^AUPNVSIT(VIEN,0),U,1)
