PXVSCSM ;SLC/PKR - V Standard Codes ScreenMan routines ;09/11/2018
;;1.0;PCE PATIENT CARE ENCOUNTER;**211**;Aug 12, 1996;Build 454
;
;===================================
CODEPAOC(DA) ;Code Post-Action On Change.
N CODE,CODESYS,EVENTDT,NEWCODE,SAVEDDS
S CODE=$$GET^DDSVAL(9000010.71,.DA,.01)
S CODESYS=$$GET^DDSVAL(9000010.71,.DA,.05)
S EVENTDT=$$GET^DDSVAL(9000010.71,.DA,1201)
I EVENTDT="" S EVENTDT=DT
;DBIA #5746 covers kill and set of DDS.
I $D(DDS) S SAVEDDS=DDS K DDS
;Call the Lexicon search.
S NEWCODE=$$GETCODE^PXLEXS(CODESYS,CODE,EVENTDT,0)
;Reset the screen so ScreenMan displays properly.
I $D(SAVEDDS) D
. N IOAWM0,X
. S DDS=SAVEDDS
. S X=0 X ^%ZOSF("RM"),^%ZOSF("TYPE-AHEAD")
. S X="IOAWM0" D ENDR^%ZISS W IOAWM0
. D REFRESH^DDSUTL
D PUT^DDSVAL(9000010.71,.DA,.01,NEWCODE)
Q
;
;===================================
CODEPRE(DA) ;Code pre-action.
N CODESYS,TEXT
S CODESYS=$$GET^DDSVAL(9000010.71,.DA,.05)
;DBIA #5679
S CODESYS=$P($$CSYS^LEXU(CODESYS),U,4)
S TEXT(1)="Input a search term or a "_CODESYS_" code."
D EN^DDIOL(.TEXT)
Q
;
;===================================
CSYSPRE() ;Coding System pre-action.
N CODESYS,CODESYSL,NL,TEXT
D CODESYSL^PXLEX(.CODESYSL,0)
S TEXT(1)="The available coding systems are:"
S CODESYS=0,NL=1
F S CODESYS=$O(CODESYSL(CODESYS)) Q:CODESYS="" D
.;DBIA #5679
. S NL=NL+1,TEXT(NL)=" "_CODESYS_" - "_$P($$CSYS^LEXU(CODESYS),U,4)
D EN^DDIOL(.TEXT)
Q
;
;===================================
VCSYS(CODESYS) ;Coding System data validation.
I CODESYS="" D Q 0
. D HLP^DDSUTL("The Coding System cannot be null.")
N CODESYSL,VALID
D CODESYSL^PXLEX(.CODESYSL,0)
S CODESYS=$$UP^XLFSTR(CODESYS)
S VALID=$S($D(CODESYSL(CODESYS)):1,1:0)
I 'VALID D HLP^DDSUTL(CODESYS_" is not a valid coding system.")
Q VALID
;
;===================================
POSTACT(D0) ;Form Post Action
Q
N INACTIVE,INUSE,OUTPUT
;If the change was a deletion there is nothing else to do.
I '$D(^AUTTEDT(D0)) Q
;If the education topic was inactivated check to see if it is being used.
;Need a new FileMan API to do this.
S INACTIVE=$$GET^DDSVAL(9000010.71,D0,"INACTIVE FLAG")
Q
;
;===================================
POSTSAVE(IEN) ;Form Post Save.
Q
;
;===================================
SMANEDIT(IEN) ;ScreenMan edit for entry IEN.
N DA,DDSCHANG,DDSFILE,DDSPARM,DDSSAVE,DEL,DIDEL,DIMSG,DR,DTOUT
S (DDSFILE,DIDEL)=9000010.71,DDSPARM="CS",DR="[PX VSC EDIT]"
S DA=IEN
D ^DDS
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXVSCSM 2533 printed Dec 13, 2024@02:32:09 Page 2
PXVSCSM ;SLC/PKR - V Standard Codes ScreenMan routines ;09/11/2018
+1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**211**;Aug 12, 1996;Build 454
+2 ;
+3 ;===================================
CODEPAOC(DA) ;Code Post-Action On Change.
+1 NEW CODE,CODESYS,EVENTDT,NEWCODE,SAVEDDS
+2 SET CODE=$$GET^DDSVAL(9000010.71,.DA,.01)
+3 SET CODESYS=$$GET^DDSVAL(9000010.71,.DA,.05)
+4 SET EVENTDT=$$GET^DDSVAL(9000010.71,.DA,1201)
+5 IF EVENTDT=""
SET EVENTDT=DT
+6 ;DBIA #5746 covers kill and set of DDS.
+7 IF $DATA(DDS)
SET SAVEDDS=DDS
KILL DDS
+8 ;Call the Lexicon search.
+9 SET NEWCODE=$$GETCODE^PXLEXS(CODESYS,CODE,EVENTDT,0)
+10 ;Reset the screen so ScreenMan displays properly.
+11 IF $DATA(SAVEDDS)
Begin DoDot:1
+12 NEW IOAWM0,X
+13 SET DDS=SAVEDDS
+14 SET X=0
XECUTE ^%ZOSF("RM")
XECUTE ^%ZOSF("TYPE-AHEAD")
+15 SET X="IOAWM0"
DO ENDR^%ZISS
WRITE IOAWM0
+16 DO REFRESH^DDSUTL
End DoDot:1
+17 DO PUT^DDSVAL(9000010.71,.DA,.01,NEWCODE)
+18 QUIT
+19 ;
+20 ;===================================
CODEPRE(DA) ;Code pre-action.
+1 NEW CODESYS,TEXT
+2 SET CODESYS=$$GET^DDSVAL(9000010.71,.DA,.05)
+3 ;DBIA #5679
+4 SET CODESYS=$PIECE($$CSYS^LEXU(CODESYS),U,4)
+5 SET TEXT(1)="Input a search term or a "_CODESYS_" code."
+6 DO EN^DDIOL(.TEXT)
+7 QUIT
+8 ;
+9 ;===================================
CSYSPRE() ;Coding System pre-action.
+1 NEW CODESYS,CODESYSL,NL,TEXT
+2 DO CODESYSL^PXLEX(.CODESYSL,0)
+3 SET TEXT(1)="The available coding systems are:"
+4 SET CODESYS=0
SET NL=1
+5 FOR
SET CODESYS=$ORDER(CODESYSL(CODESYS))
if CODESYS=""
QUIT
Begin DoDot:1
+6 ;DBIA #5679
+7 SET NL=NL+1
SET TEXT(NL)=" "_CODESYS_" - "_$PIECE($$CSYS^LEXU(CODESYS),U,4)
End DoDot:1
+8 DO EN^DDIOL(.TEXT)
+9 QUIT
+10 ;
+11 ;===================================
VCSYS(CODESYS) ;Coding System data validation.
+1 IF CODESYS=""
Begin DoDot:1
+2 DO HLP^DDSUTL("The Coding System cannot be null.")
End DoDot:1
QUIT 0
+3 NEW CODESYSL,VALID
+4 DO CODESYSL^PXLEX(.CODESYSL,0)
+5 SET CODESYS=$$UP^XLFSTR(CODESYS)
+6 SET VALID=$SELECT($DATA(CODESYSL(CODESYS)):1,1:0)
+7 IF 'VALID
DO HLP^DDSUTL(CODESYS_" is not a valid coding system.")
+8 QUIT VALID
+9 ;
+10 ;===================================
POSTACT(D0) ;Form Post Action
+1 QUIT
+2 NEW INACTIVE,INUSE,OUTPUT
+3 ;If the change was a deletion there is nothing else to do.
+4 IF '$DATA(^AUTTEDT(D0))
QUIT
+5 ;If the education topic was inactivated check to see if it is being used.
+6 ;Need a new FileMan API to do this.
+7 SET INACTIVE=$$GET^DDSVAL(9000010.71,D0,"INACTIVE FLAG")
+8 QUIT
+9 ;
+10 ;===================================
POSTSAVE(IEN) ;Form Post Save.
+1 QUIT
+2 ;
+3 ;===================================
SMANEDIT(IEN) ;ScreenMan edit for entry IEN.
+1 NEW DA,DDSCHANG,DDSFILE,DDSPARM,DDSSAVE,DEL,DIDEL,DIMSG,DR,DTOUT
+2 SET (DDSFILE,DIDEL)=9000010.71
SET DDSPARM="CS"
SET DR="[PX VSC EDIT]"
+3 SET DA=IEN
+4 DO ^DDS
+5 QUIT
+6 ;
