- 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 Mar 13, 2025@21:36:52 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 ;
