- PSJPADIU ;BP/VGH-INPATIENT PADE INVENTORY FILE UTILITIES ;3/20/18 8:35 AM
- ;;5.0;INPATIENT MEDICATIONS ;**356**;16 DEC 97;Build 7
- ;Per VHA Directive 2004-038, this routine should not be modified.
- ;
- FILDEV(PADATA,ERRMSG) ; File PADE DEVICE to PADE INVENTORY file
- N FDA,PSJPSYS,PSJSCR,PSJSCR
- I '($G(PADATA(2))]"") S ERRMSG="MISSING PADE DEVICE" Q 0
- I $G(PSJPSYS),$G(^PS(58.601,+PSJPSYS,0))]"" S PADATA("SYS IEN")=PSJPSYS
- S PSJPSYS=PADATA("SYS IEN"),PSJSCR="I $S('$G(PSJPSYS):1,1:PSJPSYS=$P(^(0),U,2))"
- I ($G(PADATA(1))=""&$G(PSJPSYS)) S PADATA(1)=$P(^PS(58.601,PSJPSYS,0),"^")
- K ERR S PADATA("DEVICE IEN")=$$FIND1^DIC(58.63,,"X",PADATA(2),,PSJSCR,"ERR") K DIERR ;*356- remove M (multiple index lookup)
- I '$G(PADATA("DEVICE IEN")) D
- .N FDA S FDA(58.63,"?+1,",.01)=PADATA(2)
- .S FDA(58.63,"?+1,",1)=PADATA(1)
- .S FDA(58.63,"?+1,",12)=$$UPPER^PSJPDRUT(PADATA(2))
- .K ERR,DIERR D UPDATE^DIE("E","FDA","","ERR") K DIERR ;*356
- .K ERR,DIERR S PADATA("DEVICE IEN")=$$FIND1^DIC(58.63,,"X",PADATA(2),,PSJSCR,"ERR") K DIERR ;*356- remove M (multiple index lookup)
- I $G(PADATA("DEVICE IEN")) D
- .N FDA S FDA(58.6011,"?+1,"_PADATA("SYS IEN")_",",.01)=PADATA(2) K ERR D UPDATE^DIE("E","FDA","","ERR") K DIERR ;*356
- .K ERR,DIERR S PADATA("DEVICE IEN")=$$FIND1^DIC(58.6011,","_PADATA("SYS IEN")_",","BX",PADATA(2),,,"ERR") K DIERR ;*356- replaced M (multiple index lookup) with B
- I '$G(PADATA("DEVICE IEN")) S ERRMSG="Unable to file PADE Device "_PADATA(2) Q 0
- Q 1
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJPADIU 1485 printed Feb 18, 2025@23:35 Page 2
- PSJPADIU ;BP/VGH-INPATIENT PADE INVENTORY FILE UTILITIES ;3/20/18 8:35 AM
- +1 ;;5.0;INPATIENT MEDICATIONS ;**356**;16 DEC 97;Build 7
- +2 ;Per VHA Directive 2004-038, this routine should not be modified.
- +3 ;
- FILDEV(PADATA,ERRMSG) ; File PADE DEVICE to PADE INVENTORY file
- +1 NEW FDA,PSJPSYS,PSJSCR,PSJSCR
- +2 IF '($GET(PADATA(2))]"")
- SET ERRMSG="MISSING PADE DEVICE"
- QUIT 0
- +3 IF $GET(PSJPSYS)
- IF $GET(^PS(58.601,+PSJPSYS,0))]""
- SET PADATA("SYS IEN")=PSJPSYS
- +4 SET PSJPSYS=PADATA("SYS IEN")
- SET PSJSCR="I $S('$G(PSJPSYS):1,1:PSJPSYS=$P(^(0),U,2))"
- +5 IF ($GET(PADATA(1))=""&$GET(PSJPSYS))
- SET PADATA(1)=$PIECE(^PS(58.601,PSJPSYS,0),"^")
- +6 ;*356- remove M (multiple index lookup)
- KILL ERR
- SET PADATA("DEVICE IEN")=$$FIND1^DIC(58.63,,"X",PADATA(2),,PSJSCR,"ERR")
- KILL DIERR
- +7 IF '$GET(PADATA("DEVICE IEN"))
- Begin DoDot:1
- +8 NEW FDA
- SET FDA(58.63,"?+1,",.01)=PADATA(2)
- +9 SET FDA(58.63,"?+1,",1)=PADATA(1)
- +10 SET FDA(58.63,"?+1,",12)=$$UPPER^PSJPDRUT(PADATA(2))
- +11 ;*356
- KILL ERR,DIERR
- DO UPDATE^DIE("E","FDA","","ERR")
- KILL DIERR
- +12 ;*356- remove M (multiple index lookup)
- KILL ERR,DIERR
- SET PADATA("DEVICE IEN")=$$FIND1^DIC(58.63,,"X",PADATA(2),,PSJSCR,"ERR")
- KILL DIERR
- End DoDot:1
- +13 IF $GET(PADATA("DEVICE IEN"))
- Begin DoDot:1
- +14 ;*356
- NEW FDA
- SET FDA(58.6011,"?+1,"_PADATA("SYS IEN")_",",.01)=PADATA(2)
- KILL ERR
- DO UPDATE^DIE("E","FDA","","ERR")
- KILL DIERR
- +15 ;*356- replaced M (multiple index lookup) with B
- KILL ERR,DIERR
- SET PADATA("DEVICE IEN")=$$FIND1^DIC(58.6011,","_PADATA("SYS IEN")_",","BX",PADATA(2),,,"ERR")
- KILL DIERR
- End DoDot:1
- +16 IF '$GET(PADATA("DEVICE IEN"))
- SET ERRMSG="Unable to file PADE Device "_PADATA(2)
- QUIT 0
- +17 QUIT 1