- PSJ53P1 ;BIR/DB - API FOR INFORMATION FROM FILE 53.1; 5 Sep 03
- ;;5.0;INPATIENT MEDICATIONS ;**172,260**;16 DEC 97;Build 94
- PSJ(PSJIEN,LIST) ;
- ;PSJIEN - INTERNAL ENTRY NUMBER [REQUIRED]
- ;LIST: Subscript name used in ^TMP global [REQUIRED]
- I $G(PSJIEN)="" Q
- I $G(LIST)="" Q
- K ^TMP($J,LIST),DA,^UTILITY("DIQ1",$J),DIQ
- N SEQ,DATA
- I $G(PSJIEN)]"" S DA=PSJIEN I '$D(^PS(53.1,DA,0)) G RET0
- K ^UTILITY("DIQ1",$J),DIC S DIC=53.1,DR=".01;1;3;7;10;25;26;27;28;108;109;115;116;117",DIQ(0)="IE" D EN^DIQ1
- I '$D(^UTILITY("DIQ1",$J)) G RET0
- S ^TMP($J,LIST,0)=1,PSJDA=DA
- S PSJTXT=^UTILITY("DIQ1",$J,53.1,DA,.01,"E")
- F X=.01,1,3,7,10,26,27,28,25,108,109,115,116,117 S ^TMP($J,LIST,DA,X)=$G(^UTILITY("DIQ1",$J,53.1,DA,X,"I"))
- F X=1,3,7,10,28,25,26,108,115,116,117 S ^TMP($J,LIST,DA,X)=$S($G(^UTILITY("DIQ1",$J,53.1,DA,X,"E"))'="":^TMP($J,LIST,DA,X)_"^"_$G(^UTILITY("DIQ1",$J,53.1,DA,X,"E")),1:"")
- S ^TMP($J,LIST,"B",PSJTXT,DA)=""
- S PSJDRG=0 F S PSJDRG=$O(^PS(53.1,PSJDA,1,PSJDRG)) Q:PSJDRG'>0 D
- .S DA=PSJDA,DIC=53.1,DR=2,DR(53.11)=".01;.02",DIQ(0)="IE",DA(53.11)=PSJDRG D EN^DIQ1 Q:'$D(^UTILITY("DIQ1",$J))
- .S ^TMP($J,LIST,PSJDA,"DDRUG",PSJDRG,.01)=$G(^UTILITY("DIQ1",$J,53.11,PSJDRG,.01,"I"))
- .S ^TMP($J,LIST,PSJDA,"DDRUG",PSJDRG,.02)=$G(^UTILITY("DIQ1",$J,53.11,PSJDRG,.02,"I"))
- .S ^TMP($J,LIST,PSJDA,"DDRUG",PSJDRG,.01)=$S($G(^UTILITY("DIQ1",$J,53.11,PSJDRG,.01,"E"))'="":^TMP($J,LIST,PSJDA,"DDRUG",PSJDRG,.01)_"^"_$G(^UTILITY("DIQ1",$J,53.11,PSJDRG,.01,"E")),1:"")
- .S ^TMP($J,LIST,PSJDA,"DDRUG",0)=$G(^TMP($J,LIST,PSJDA,"DDRUG",0))+1
- I '$D(^TMP($J,LIST,PSJDA,"DDRUG",0)) S ^TMP($J,LIST,PSJDA,"DDRUG",0)="-1^NO DATA FOUND"
- S SEQ=0 F S SEQ=$O(^PS(53.1,DA,"AD",SEQ)) Q:SEQ=""!(SEQ'?1N.N) D
- .S (ADDITIVE,DATA)="",DATA=^PS(53.1,DA,"AD",SEQ,0),$P(DATA,"^")=$$GET1^DIQ(52.6,$P(DATA,"^"),.01),^TMP($J,LIST,DA,"ADD",SEQ)=DATA
- I '$D(^TMP($J,LIST,DA,"ADD")) S ^TMP($J,LIST,DA,"ADD",0)="-1^NO DATA FOUND"
- S SEQ=0 F S SEQ=$O(^PS(53.1,DA,"SOL",SEQ)) Q:SEQ=""!(SEQ'?1N.N) D
- .S (SOLUTION,DATA)="",DATA=^PS(53.1,DA,"SOL",SEQ,0),$P(DATA,"^")=$$GET1^DIQ(52.7,$P(DATA,"^"),.01),^TMP($J,LIST,DA,"SOL",SEQ)=DATA
- I '$D(^TMP($J,LIST,DA,"SOL")) S ^TMP($J,LIST,DA,"SOL",0)="-1^NO DATA FOUND"
- K PSJIEN,DA,X,PSJTXT,DR,DIC,^UTILITY("DIQ1",$J),DIQ,PSJDA,PSJDRG
- Q
- RET0 ;return no data
- K PSJIEN,PSJTXT S ^TMP($J,LIST,0)="-1^NO DATA FOUND" Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJ53P1 2366 printed Mar 13, 2025@21:10:49 Page 2
- PSJ53P1 ;BIR/DB - API FOR INFORMATION FROM FILE 53.1; 5 Sep 03
- +1 ;;5.0;INPATIENT MEDICATIONS ;**172,260**;16 DEC 97;Build 94
- PSJ(PSJIEN,LIST) ;
- +1 ;PSJIEN - INTERNAL ENTRY NUMBER [REQUIRED]
- +2 ;LIST: Subscript name used in ^TMP global [REQUIRED]
- +3 IF $GET(PSJIEN)=""
- QUIT
- +4 IF $GET(LIST)=""
- QUIT
- +5 KILL ^TMP($JOB,LIST),DA,^UTILITY("DIQ1",$JOB),DIQ
- +6 NEW SEQ,DATA
- +7 IF $GET(PSJIEN)]""
- SET DA=PSJIEN
- IF '$DATA(^PS(53.1,DA,0))
- GOTO RET0
- +8 KILL ^UTILITY("DIQ1",$JOB),DIC
- SET DIC=53.1
- SET DR=".01;1;3;7;10;25;26;27;28;108;109;115;116;117"
- SET DIQ(0)="IE"
- DO EN^DIQ1
- +9 IF '$DATA(^UTILITY("DIQ1",$JOB))
- GOTO RET0
- +10 SET ^TMP($JOB,LIST,0)=1
- SET PSJDA=DA
- +11 SET PSJTXT=^UTILITY("DIQ1",$JOB,53.1,DA,.01,"E")
- +12 FOR X=.01,1,3,7,10,26,27,28,25,108,109,115,116,117
- SET ^TMP($JOB,LIST,DA,X)=$GET(^UTILITY("DIQ1",$JOB,53.1,DA,X,"I"))
- +13 FOR X=1,3,7,10,28,25,26,108,115,116,117
- SET ^TMP($JOB,LIST,DA,X)=$SELECT($GET(^UTILITY("DIQ1",$JOB,53.1,DA,X,"E"))'="":^TMP($JOB,LIST,DA,X)_"^"_$GET(^UTILITY("DIQ1",$JOB,53.1,DA,X,"E")),1:"")
- +14 SET ^TMP($JOB,LIST,"B",PSJTXT,DA)=""
- +15 SET PSJDRG=0
- FOR
- SET PSJDRG=$ORDER(^PS(53.1,PSJDA,1,PSJDRG))
- if PSJDRG'>0
- QUIT
- Begin DoDot:1
- +16 SET DA=PSJDA
- SET DIC=53.1
- SET DR=2
- SET DR(53.11)=".01;.02"
- SET DIQ(0)="IE"
- SET DA(53.11)=PSJDRG
- DO EN^DIQ1
- if '$DATA(^UTILITY("DIQ1",$JOB))
- QUIT
- +17 SET ^TMP($JOB,LIST,PSJDA,"DDRUG",PSJDRG,.01)=$GET(^UTILITY("DIQ1",$JOB,53.11,PSJDRG,.01,"I"))
- +18 SET ^TMP($JOB,LIST,PSJDA,"DDRUG",PSJDRG,.02)=$GET(^UTILITY("DIQ1",$JOB,53.11,PSJDRG,.02,"I"))
- +19 SET ^TMP($JOB,LIST,PSJDA,"DDRUG",PSJDRG,.01)=$SELECT($GET(^UTILITY("DIQ1",$JOB,53.11,PSJDRG,.01,"E"))'="":^TMP($JOB,LIST,PSJDA,"DDRUG",PSJDRG,.01)_"^"_$GET(^UTILITY("DIQ1",$JOB,53.11,PSJDRG,.01,"E")),1:"")
- +20 SET ^TMP($JOB,LIST,PSJDA,"DDRUG",0)=$GET(^TMP($JOB,LIST,PSJDA,"DDRUG",0))+1
- End DoDot:1
- +21 IF '$DATA(^TMP($JOB,LIST,PSJDA,"DDRUG",0))
- SET ^TMP($JOB,LIST,PSJDA,"DDRUG",0)="-1^NO DATA FOUND"
- +22 SET SEQ=0
- FOR
- SET SEQ=$ORDER(^PS(53.1,DA,"AD",SEQ))
- if SEQ=""!(SEQ'?1N.N)
- QUIT
- Begin DoDot:1
- +23 SET (ADDITIVE,DATA)=""
- SET DATA=^PS(53.1,DA,"AD",SEQ,0)
- SET $PIECE(DATA,"^")=$$GET1^DIQ(52.6,$PIECE(DATA,"^"),.01)
- SET ^TMP($JOB,LIST,DA,"ADD",SEQ)=DATA
- End DoDot:1
- +24 IF '$DATA(^TMP($JOB,LIST,DA,"ADD"))
- SET ^TMP($JOB,LIST,DA,"ADD",0)="-1^NO DATA FOUND"
- +25 SET SEQ=0
- FOR
- SET SEQ=$ORDER(^PS(53.1,DA,"SOL",SEQ))
- if SEQ=""!(SEQ'?1N.N)
- QUIT
- Begin DoDot:1
- +26 SET (SOLUTION,DATA)=""
- SET DATA=^PS(53.1,DA,"SOL",SEQ,0)
- SET $PIECE(DATA,"^")=$$GET1^DIQ(52.7,$PIECE(DATA,"^"),.01)
- SET ^TMP($JOB,LIST,DA,"SOL",SEQ)=DATA
- End DoDot:1
- +27 IF '$DATA(^TMP($JOB,LIST,DA,"SOL"))
- SET ^TMP($JOB,LIST,DA,"SOL",0)="-1^NO DATA FOUND"
- +28 KILL PSJIEN,DA,X,PSJTXT,DR,DIC,^UTILITY("DIQ1",$JOB),DIQ,PSJDA,PSJDRG
- +29 QUIT
- RET0 ;return no data
- +1 KILL PSJIEN,PSJTXT
- SET ^TMP($JOB,LIST,0)="-1^NO DATA FOUND"
- QUIT
