PSS50AQM ;BIR/LDT - CONTINUATION OF API FOR INFORMATION FROM FILE 50; 5 Sep 03
;;1.0;PHARMACY DATA MANAGEMENT;**85,91,104**;9/30/97
;External reference to PS(50.3 supported by DBIA 2127
;External reference to PS(50.605 supported by DBIA 2138
;External reference to PSNDF(50.6 supported by DBIA 2079
;External reference to PSNDF(50.68 supported by DBIA 3735
;
SETALL ;
N PSSZNODE,PSS660,PSSNDNOD,PSS2NODE,PSSG2NOD S PSSZNODE=$G(^PSDRUG(PSS(1),0)),PSS2NODE=$G(^(2)),PSS660=$G(^(660)),PSSG2NOD=$G(^("PSG")),PSSNDNOD=$G(^("ND"))
S ^TMP($J,LIST,+PSS(1),.01)=$P(PSSZNODE,"^")
S ^TMP($J,LIST,"B",$P(PSSZNODE,"^"),+PSS(1))=""
S ^TMP($J,LIST,+PSS(1),2)=$P(PSSZNODE,"^",2)
S ^TMP($J,LIST,+PSS(1),2.1)=$S('$P(PSS2NODE,"^"):"",1:$P(PSS2NODE,"^")_"^"_$P($G(^PS(50.7,+$P(PSS2NODE,"^"),0)),"^"))
N PSSADDF S PSSADDF=$P($G(^PS(50.7,+$P($G(^TMP($J,LIST,+PSS(1),2.1)),"^"),0)),"^",2) I PSSADDF>0 D
.S ^TMP($J,LIST,+PSS(1),2.1)=^TMP($J,LIST,+PSS(1),2.1)_"^"_PSSADDF_"^"_$P($G(^PS(50.606,PSSADDF,0)),"^")
S ^TMP($J,LIST,+PSS(1),3)=$P(PSSZNODE,"^",3)
S ^TMP($J,LIST,+PSS(1),4)=$P(PSSZNODE,"^",4)
S ^TMP($J,LIST,+PSS(1),5)=$P(PSSZNODE,"^",5)
S ^TMP($J,LIST,+PSS(1),6)=$P(PSSZNODE,"^",6)
S ^TMP($J,LIST,+PSS(1),8)=$P(PSSZNODE,"^",8)
S ^TMP($J,LIST,+PSS(1),12)=$S($P(PSS660,"^",2):$P(PSS660,"^",2)_"^"_$P($G(^DIC(51.5,+$P(PSS660,"^",2),0)),"^")_"^"_$P($G(^(0)),"^",2),1:"")
S ^TMP($J,LIST,+PSS(1),13)=$P(PSS660,"^",3)
S ^TMP($J,LIST,+PSS(1),14.5)=$P(PSS660,"^",8)
S ^TMP($J,LIST,+PSS(1),15)=$P(PSS660,"^",5)
S ^TMP($J,LIST,+PSS(1),16)=$P(PSS660,"^",6)
S ^TMP($J,LIST,+PSS(1),20)=$S($P(PSSNDNOD,"^"):$P(PSSNDNOD,"^")_"^"_$P($G(^PSNDF(50.6,+$P(PSSNDNOD,"^"),0)),"^"),1:"")
S ^TMP($J,LIST,+PSS(1),21)=$P(PSSNDNOD,"^",2)
S ^TMP($J,LIST,+PSS(1),22)=$S($P(PSSNDNOD,"^",3):$P(PSSNDNOD,"^",3)_"^"_$P($G(^PSNDF(50.68,+$P(PSSNDNOD,"^",3),0)),"^"),1:"")
S ^TMP($J,LIST,+PSS(1),25)=$S($P(PSSNDNOD,"^",6):$P(PSSNDNOD,"^",6)_"^"_$P($G(^PS(50.605,+$P(PSSNDNOD,"^",6),0)),"^")_"^"_$P($G(^(0)),"^",2),1:"")
S ^TMP($J,LIST,+PSS(1),27)=$P(PSSNDNOD,"^",10)
S ^TMP($J,LIST,+PSS(1),31)=$P(PSS2NODE,"^",4)
S ^TMP($J,LIST,+PSS(1),40)=$P($G(^PSDRUG(PSS(1),"PSO")),"^")
N PSS51NF S PSS51NF=$P(PSSZNODE,"^",9) D
.I PSS51NF'="",PSS51NFD'="",PSS51NFD[(PSS51NF_":") S ^TMP($J,LIST,+PSS(1),51)=PSS51NF_"^"_$P($E(PSS51NFD,$F(PSS51NFD,(PSS51NF_":")),999),";") Q
.S ^TMP($J,LIST,+PSS(1),51)=""
N PSS52NF S PSS52NF=$P(PSSZNODE,"^",11) D
.I PSS52NF'="",PSS52NFD'="",PSS52NFD[(PSS52NF_":") S ^TMP($J,LIST,+PSS(1),52)=PSS52NF_"^"_$P($E(PSS52NFD,$F(PSS52NFD,(PSS52NF_":")),999),";") Q
.S ^TMP($J,LIST,+PSS(1),52)=""
S ^TMP($J,LIST,+PSS(1),63)=$P(PSS2NODE,"^",3)
S ^TMP($J,LIST,+PSS(1),64)=$S($P(PSS2NODE,"^",6):$P(PSS2NODE,"^",6)_"^"_$P($G(^PS(50.3,+$P(PSS2NODE,"^",6),0)),"^"),1:"")
N Y S Y=$P($G(^PSDRUG(PSS(1),"I")),"^") D
.I Y S ^TMP($J,LIST,+PSS(1),100)=$G(Y) X ^DD("DD") S ^TMP($J,LIST,+PSS(1),100)=^TMP($J,LIST,+PSS(1),100)_"^"_$G(Y) Q
.S ^TMP($J,LIST,+PSS(1),100)=""
S ^TMP($J,LIST,+PSS(1),101)=$P(PSSZNODE,"^",10)
S ^TMP($J,LIST,+PSS(1),102)=$P(PSS2NODE,"^",2)
N PSSG2 S PSSG2=$P(PSSG2NOD,"^",2) D
.I PSSG2'="",PSSG2N'="",PSSG2N[(PSSG2_":") S ^TMP($J,LIST,+PSS(1),301)=PSSG2_"^"_$P($E(PSSG2N,$F(PSSG2N,(PSSG2_":")),999),";") Q
.S ^TMP($J,LIST,+PSS(1),301)=""
S ^TMP($J,LIST,+PSS(1),302)=$P(PSSG2NOD,"^",3)
;Set new Service Code field
I $$PATCH^XPDUTL("PSS*1.0*92") D
.S ^TMP($J,LIST,+PSS(1),400)=$P($G(^PSDRUG(+PSS(1),"PFS")),"^")
.I $P(PSSNDNOD,"^",3),$P($G(^PSNDF(50.68,+$P(PSSNDNOD,"^",3),"PFS")),"^")'="" S ^TMP($J,LIST,+PSS(1),400)=$P($G(^PSNDF(50.68,+$P(PSSNDNOD,"^",3),"PFS")),"^")
.I $P($G(^TMP($J,LIST,+PSS(1),400)),"^")="" S ^TMP($J,LIST,+PSS(1),400)=600000
Q
;
;
SETSYN ;
N PSS501C S PSS501C=0
I $O(^PSDRUG(PSS(1),1,0)) N PSS501,PSS501ND D
.F PSS501=0:0 S PSS501=$O(^PSDRUG(PSS(1),1,PSS501)) Q:'PSS501 D
..S PSS501ND=$G(^PSDRUG(PSS(1),1,PSS501,0)) I $P(PSS501ND,"^")'="" S PSS501C=PSS501C+1 D
...S ^TMP($J,LIST,+PSS(1),"SYN",PSS501,.01)=$P(PSS501ND,"^")
...N PSS501NN S PSS501NN=$P(PSS501ND,"^",3) D
....I PSS501NN'="",PSS501NX'="",PSS501NX[(PSS501NN_":") S ^TMP($J,LIST,+PSS(1),"SYN",PSS501,1)=PSS501NN_"^"_$P($E(PSS501NX,$F(PSS501NX,(PSS501NN_":")),999),";") Q
....S ^TMP($J,LIST,+PSS(1),"SYN",PSS501,1)=""
...S ^TMP($J,LIST,+PSS(1),"SYN",PSS501,2)=$P(PSS501ND,"^",2)
...S ^TMP($J,LIST,+PSS(1),"SYN",PSS501,403)=$P(PSS501ND,"^",7)
S ^TMP($J,LIST,+PSS(1),"SYN",0)=$S(PSS501C:PSS501C,1:"-1^NO DATA FOUND")
Q
;
SETFMA ;
N PSS65C S PSS65C=0
I $O(^PSDRUG(PSS(1),65,0)) N PSS65,PSS65ND D
.F PSS65=0:0 S PSS65=$O(^PSDRUG(PSS(1),65,PSS65)) Q:'PSS65 D
..S PSS65ND=$G(^PSDRUG(PSS(1),65,PSS65,0)) I $P(PSS65ND,"^") S PSS65C=PSS65C+1 D
...S ^TMP($J,LIST,+PSS(1),"FRM",PSS65,.01)=$P(PSS65ND,"^")_"^"_$P($G(^PSDRUG(+$P(PSS65ND,"^"),0)),"^")
S ^TMP($J,LIST,+PSS(1),"FRM",0)=$S(PSS65C:PSS65C,1:"-1^NO DATA FOUND")
Q
;
SETOLD ;
N PSS900C S PSS900C=0
I $O(^PSDRUG(PSS(1),900,0)) N PSS900,PSS900ND D
.F PSS900=0:0 S PSS900=$O(^PSDRUG(PSS(1),900,PSS900)) Q:'PSS900 D
..S PSS900ND=$G(^PSDRUG(PSS(1),900,PSS900,0)) I $P(PSS900ND,"^")'="" S PSS900C=PSS900C+1 D
...S ^TMP($J,LIST,+PSS(1),"OLD",PSS900,.01)=$P(PSS900ND,"^")
...N Y S Y=$P(PSS900ND,"^",2) I Y S ^TMP($J,LIST,+PSS(1),"OLD",PSS900,.02)=$G(Y) X ^DD("DD") S ^TMP($J,LIST,+PSS(1),"OLD",PSS900,.02)=^TMP($J,LIST,+PSS(1),"OLD",PSS900,.02)_"^"_$G(Y)
S ^TMP($J,LIST,+PSS(1),"OLD",0)=$S(PSS900C:PSS900C,1:"-1^NO DATA FOUND")
Q
SETSUB1(PSST1) ;Set sub-header nodes if there is data, and sub-header nodes do not exist
N PSST2,PSST3,PSST4
I $G(^PSDRUG(PSST1,1,0))="",$O(^PSDRUG(PSST1,1,0)) D
.S (PSST4,PSST3)=0 F PSST2=0:0 S PSST2=$O(^PSDRUG(PSST1,1,PSST2)) Q:'PSST2 I $D(^PSDRUG(PSST1,1,PSST2,0)) S PSST3=PSST2,PSST4=PSST4+1
.I PSST4 S ^PSDRUG(PSST1,1,0)="^50.1A^"_PSST3_"^"_PSST4
Q
SETSUB2(PSST1) ;
N PSST2,PSST3,PSST4
I $G(^PSDRUG(PSST1,65,0))="",$O(^PSDRUG(PSST1,65,0)) D
.S (PSST4,PSST3)=0 F PSST2=0:0 S PSST2=$O(^PSDRUG(PSST1,65,PSST2)) Q:'PSST2 I $D(^PSDRUG(PSST1,65,PSST2,0)) S PSST3=PSST2,PSST4=PSST4+1
.I PSST4 S ^PSDRUG(PSST1,65,0)="^50.065P^"_PSST3_"^"_PSST4
Q
SETSUB3(PSST1) ;
N PSST2,PSST3,PSST4
I $G(^PSDRUG(PSST1,900,0))="",$O(^PSDRUG(PSST1,900,0)) D
.S (PSST4,PSST3)=0 F PSST2=0:0 S PSST2=$O(^PSDRUG(PSST1,900,PSST2)) Q:'PSST2 I $D(^PSDRUG(PSST1,900,PSST2,0)) S PSST3=PSST2,PSST4=PSST4+1
.I PSST4 S ^PSDRUG(PSST1,900,0)="^50.01A^"_PSST3_"^"_PSST4
Q
SETSUB4(PSST1) ;
N PSST2,PSST3,PSST4
I $G(^PSDRUG(PSST1,441,0))="",$O(^PSDRUG(PSST1,441,0)) D
.S (PSST4,PSST3)=0 F PSST2=0:0 S PSST2=$O(^PSDRUG(PSST1,441,PSST2)) Q:'PSST2 I $D(^PSDRUG(PSST1,441,PSST2,0)) S PSST3=PSST2,PSST4=PSST4+1
.I PSST4 S ^PSDRUG(PSST1,441,0)="^50.0441P^"_PSST3_"^"_PSST4
Q
SETSUB5(PSST1) ;
N PSST2,PSST3,PSST4
I $G(^PSDRUG(PSST1,4,0))="",$O(^PSDRUG(PSST1,4,0)) D
.S (PSST4,PSST3)=0 F PSST2=0:0 S PSST2=$O(^PSDRUG(PSST1,4,PSST2)) Q:'PSST2 I $D(^PSDRUG(PSST1,4,PSST2,0)) S PSST3=PSST2,PSST4=PSST4+1
.I PSST4 S ^PSDRUG(PSST1,4,0)="^50.0214DA^"_PSST3_"^"_PSST4
Q
SETSUB6(PSST1) ;
N PSST2,PSST3,PSST4
I $G(^PSDRUG(PSST1,"CLOZ2",0))="",$O(^PSDRUG(PSST1,"CLOZ2",0)) D
.S (PSST4,PSST3)=0 F PSST2=0:0 S PSST2=$O(^PSDRUG(PSST1,"CLOZ2",PSST2)) Q:'PSST2 I $D(^PSDRUG(PSST1,"CLOZ2",PSST2,0)) S PSST3=PSST2,PSST4=PSST4+1
.I PSST4 S ^PSDRUG(PSST1,"CLOZ2",0)="^50.02P^"_PSST3_"^"_PSST4
Q
SETSUB7(PSST1) ;
N PSST2,PSST3,PSST4
I $G(^PSDRUG(PSST1,"DOS1",0))="",$O(^PSDRUG(PSST1,"DOS1",0)) D
.S (PSST4,PSST3)=0 F PSST2=0:0 S PSST2=$O(^PSDRUG(PSST1,"DOS1",PSST2)) Q:'PSST2 I $D(^PSDRUG(PSST1,"DOS1",PSST2,0)) S PSST3=PSST2,PSST4=PSST4+1
.I PSST4 S ^PSDRUG(PSST1,"DOS1",0)="^50.0903^"_PSST3_"^"_PSST4
Q
SETSUB8(PSST1) ;
N PSST2,PSST3,PSST4
I $G(^PSDRUG(PSST1,"DOS2",0))="",$O(^PSDRUG(PSST1,"DOS2",0)) D
.S (PSST4,PSST3)=0 F PSST2=0:0 S PSST2=$O(^PSDRUG(PSST1,"DOS2",PSST2)) Q:'PSST2 I $D(^PSDRUG(PSST1,"DOS2",PSST2,0)) S PSST3=PSST2,PSST4=PSST4+1
.I PSST4 S ^PSDRUG(PSST1,"DOS2",0)="^50.0904^"_PSST3_"^"_PSST4
Q
SETSUB9(PSST1) ;
N PSST2,PSST3,PSST4
I $G(^PSDRUG(PSST1,212,0))="",$O(^PSDRUG(PSST1,212,0)) D
.S (PSST4,PSST3)=0 F PSST2=0:0 S PSST2=$O(^PSDRUG(PSST1,212,PSST2)) Q:'PSST2 I $D(^PSDRUG(PSST1,212,PSST2,0)) S PSST3=PSST2,PSST4=PSST4+1
.I PSST4 S ^PSDRUG(PSST1,212,0)="^50.0212P^"_PSST3_"^"_PSST4
Q
SETDF(PSSIEN) ;
;PSSIEN - IEN of entry in PHARMACY ORDERABLE ITEM file (#50.7).
;Returns NAME field (#.01) of PHARMACY ORDERABLE ITEM file (#50.7) and DOSAGE FORM
N DIERR,ZZERR,PSS50P7,PSS
I +$G(PSSIEN)'>0 Q -1_"^"_"NO DATA FOUND"
D GETS^DIQ(50.7,+PSSIEN,".01;.02","IE","PSS50P7")
I '$D(PSS50P7) Q -1_"^"_"NO DATA FOUND"
Q $G(PSSIEN)_"^"_$G(PSS50P7(50.7,PSSIEN_",",.01,"I"))_"^"_$G(PSS50P7(50.7,PSSIEN_",",.02,"I"))_"^"_$G(PSS50P7(50.7,PSSIEN_",",.02,"E"))
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSS50AQM 8820 printed Sep 23, 2025@20:05:22 Page 2
PSS50AQM ;BIR/LDT - CONTINUATION OF API FOR INFORMATION FROM FILE 50; 5 Sep 03
+1 ;;1.0;PHARMACY DATA MANAGEMENT;**85,91,104**;9/30/97
+2 ;External reference to PS(50.3 supported by DBIA 2127
+3 ;External reference to PS(50.605 supported by DBIA 2138
+4 ;External reference to PSNDF(50.6 supported by DBIA 2079
+5 ;External reference to PSNDF(50.68 supported by DBIA 3735
+6 ;
SETALL ;
+1 NEW PSSZNODE,PSS660,PSSNDNOD,PSS2NODE,PSSG2NOD
SET PSSZNODE=$GET(^PSDRUG(PSS(1),0))
SET PSS2NODE=$GET(^(2))
SET PSS660=$GET(^(660))
SET PSSG2NOD=$GET(^("PSG"))
SET PSSNDNOD=$GET(^("ND"))
+2 SET ^TMP($JOB,LIST,+PSS(1),.01)=$PIECE(PSSZNODE,"^")
+3 SET ^TMP($JOB,LIST,"B",$PIECE(PSSZNODE,"^"),+PSS(1))=""
+4 SET ^TMP($JOB,LIST,+PSS(1),2)=$PIECE(PSSZNODE,"^",2)
+5 SET ^TMP($JOB,LIST,+PSS(1),2.1)=$SELECT('$PIECE(PSS2NODE,"^"):"",1:$PIECE(PSS2NODE,"^")_"^"_$PIECE($GET(^PS(50.7,+$PIECE(PSS2NODE,"^"),0)),"^"))
+6 NEW PSSADDF
SET PSSADDF=$PIECE($GET(^PS(50.7,+$PIECE($GET(^TMP($JOB,LIST,+PSS(1),2.1)),"^"),0)),"^",2)
IF PSSADDF>0
Begin DoDot:1
+7 SET ^TMP($JOB,LIST,+PSS(1),2.1)=^TMP($JOB,LIST,+PSS(1),2.1)_"^"_PSSADDF_"^"_$PIECE($GET(^PS(50.606,PSSADDF,0)),"^")
End DoDot:1
+8 SET ^TMP($JOB,LIST,+PSS(1),3)=$PIECE(PSSZNODE,"^",3)
+9 SET ^TMP($JOB,LIST,+PSS(1),4)=$PIECE(PSSZNODE,"^",4)
+10 SET ^TMP($JOB,LIST,+PSS(1),5)=$PIECE(PSSZNODE,"^",5)
+11 SET ^TMP($JOB,LIST,+PSS(1),6)=$PIECE(PSSZNODE,"^",6)
+12 SET ^TMP($JOB,LIST,+PSS(1),8)=$PIECE(PSSZNODE,"^",8)
+13 SET ^TMP($JOB,LIST,+PSS(1),12)=$SELECT($PIECE(PSS660,"^",2):$PIECE(PSS660,"^",2)_"^"_$PIECE($GET(^DIC(51.5,+$PIECE(PSS660,"^",2),0)),"^")_"^"_$PIECE($GET(^(0)),"^",2),1:"")
+14 SET ^TMP($JOB,LIST,+PSS(1),13)=$PIECE(PSS660,"^",3)
+15 SET ^TMP($JOB,LIST,+PSS(1),14.5)=$PIECE(PSS660,"^",8)
+16 SET ^TMP($JOB,LIST,+PSS(1),15)=$PIECE(PSS660,"^",5)
+17 SET ^TMP($JOB,LIST,+PSS(1),16)=$PIECE(PSS660,"^",6)
+18 SET ^TMP($JOB,LIST,+PSS(1),20)=$SELECT($PIECE(PSSNDNOD,"^"):$PIECE(PSSNDNOD,"^")_"^"_$PIECE($GET(^PSNDF(50.6,+$PIECE(PSSNDNOD,"^"),0)),"^"),1:"")
+19 SET ^TMP($JOB,LIST,+PSS(1),21)=$PIECE(PSSNDNOD,"^",2)
+20 SET ^TMP($JOB,LIST,+PSS(1),22)=$SELECT($PIECE(PSSNDNOD,"^",3):$PIECE(PSSNDNOD,"^",3)_"^"_$PIECE($GET(^PSNDF(50.68,+$PIECE(PSSNDNOD,"^",3),0)),"^"),1:"")
+21 SET ^TMP($JOB,LIST,+PSS(1),25)=$SELECT($PIECE(PSSNDNOD,"^",6):$PIECE(PSSNDNOD,"^",6)_"^"_$PIECE($GET(^PS(50.605,+$PIECE(PSSNDNOD,"^",6),0)),"^")_"^"_$PIECE($GET(^(0)),"^",2),1:"")
+22 SET ^TMP($JOB,LIST,+PSS(1),27)=$PIECE(PSSNDNOD,"^",10)
+23 SET ^TMP($JOB,LIST,+PSS(1),31)=$PIECE(PSS2NODE,"^",4)
+24 SET ^TMP($JOB,LIST,+PSS(1),40)=$PIECE($GET(^PSDRUG(PSS(1),"PSO")),"^")
+25 NEW PSS51NF
SET PSS51NF=$PIECE(PSSZNODE,"^",9)
Begin DoDot:1
+26 IF PSS51NF'=""
IF PSS51NFD'=""
IF PSS51NFD[(PSS51NF_":")
SET ^TMP($JOB,LIST,+PSS(1),51)=PSS51NF_"^"_$PIECE($EXTRACT(PSS51NFD,$FIND(PSS51NFD,(PSS51NF_":")),999),";")
QUIT
+27 SET ^TMP($JOB,LIST,+PSS(1),51)=""
End DoDot:1
+28 NEW PSS52NF
SET PSS52NF=$PIECE(PSSZNODE,"^",11)
Begin DoDot:1
+29 IF PSS52NF'=""
IF PSS52NFD'=""
IF PSS52NFD[(PSS52NF_":")
SET ^TMP($JOB,LIST,+PSS(1),52)=PSS52NF_"^"_$PIECE($EXTRACT(PSS52NFD,$FIND(PSS52NFD,(PSS52NF_":")),999),";")
QUIT
+30 SET ^TMP($JOB,LIST,+PSS(1),52)=""
End DoDot:1
+31 SET ^TMP($JOB,LIST,+PSS(1),63)=$PIECE(PSS2NODE,"^",3)
+32 SET ^TMP($JOB,LIST,+PSS(1),64)=$SELECT($PIECE(PSS2NODE,"^",6):$PIECE(PSS2NODE,"^",6)_"^"_$PIECE($GET(^PS(50.3,+$PIECE(PSS2NODE,"^",6),0)),"^"),1:"")
+33 NEW Y
SET Y=$PIECE($GET(^PSDRUG(PSS(1),"I")),"^")
Begin DoDot:1
+34 IF Y
SET ^TMP($JOB,LIST,+PSS(1),100)=$GET(Y)
XECUTE ^DD("DD")
SET ^TMP($JOB,LIST,+PSS(1),100)=^TMP($JOB,LIST,+PSS(1),100)_"^"_$GET(Y)
QUIT
+35 SET ^TMP($JOB,LIST,+PSS(1),100)=""
End DoDot:1
+36 SET ^TMP($JOB,LIST,+PSS(1),101)=$PIECE(PSSZNODE,"^",10)
+37 SET ^TMP($JOB,LIST,+PSS(1),102)=$PIECE(PSS2NODE,"^",2)
+38 NEW PSSG2
SET PSSG2=$PIECE(PSSG2NOD,"^",2)
Begin DoDot:1
+39 IF PSSG2'=""
IF PSSG2N'=""
IF PSSG2N[(PSSG2_":")
SET ^TMP($JOB,LIST,+PSS(1),301)=PSSG2_"^"_$PIECE($EXTRACT(PSSG2N,$FIND(PSSG2N,(PSSG2_":")),999),";")
QUIT
+40 SET ^TMP($JOB,LIST,+PSS(1),301)=""
End DoDot:1
+41 SET ^TMP($JOB,LIST,+PSS(1),302)=$PIECE(PSSG2NOD,"^",3)
+42 ;Set new Service Code field
+43 IF $$PATCH^XPDUTL("PSS*1.0*92")
Begin DoDot:1
+44 SET ^TMP($JOB,LIST,+PSS(1),400)=$PIECE($GET(^PSDRUG(+PSS(1),"PFS")),"^")
+45 IF $PIECE(PSSNDNOD,"^",3)
IF $PIECE($GET(^PSNDF(50.68,+$PIECE(PSSNDNOD,"^",3),"PFS")),"^")'=""
SET ^TMP($JOB,LIST,+PSS(1),400)=$PIECE($GET(^PSNDF(50.68,+$PIECE(PSSNDNOD,"^",3),"PFS")),"^")
+46 IF $PIECE($GET(^TMP($JOB,LIST,+PSS(1),400)),"^")=""
SET ^TMP($JOB,LIST,+PSS(1),400)=600000
End DoDot:1
+47 QUIT
+48 ;
+49 ;
SETSYN ;
+1 NEW PSS501C
SET PSS501C=0
+2 IF $ORDER(^PSDRUG(PSS(1),1,0))
NEW PSS501,PSS501ND
Begin DoDot:1
+3 FOR PSS501=0:0
SET PSS501=$ORDER(^PSDRUG(PSS(1),1,PSS501))
if 'PSS501
QUIT
Begin DoDot:2
+4 SET PSS501ND=$GET(^PSDRUG(PSS(1),1,PSS501,0))
IF $PIECE(PSS501ND,"^")'=""
SET PSS501C=PSS501C+1
Begin DoDot:3
+5 SET ^TMP($JOB,LIST,+PSS(1),"SYN",PSS501,.01)=$PIECE(PSS501ND,"^")
+6 NEW PSS501NN
SET PSS501NN=$PIECE(PSS501ND,"^",3)
Begin DoDot:4
+7 IF PSS501NN'=""
IF PSS501NX'=""
IF PSS501NX[(PSS501NN_":")
SET ^TMP($JOB,LIST,+PSS(1),"SYN",PSS501,1)=PSS501NN_"^"_$PIECE($EXTRACT(PSS501NX,$FIND(PSS501NX,(PSS501NN_":")),999),";")
QUIT
+8 SET ^TMP($JOB,LIST,+PSS(1),"SYN",PSS501,1)=""
End DoDot:4
+9 SET ^TMP($JOB,LIST,+PSS(1),"SYN",PSS501,2)=$PIECE(PSS501ND,"^",2)
+10 SET ^TMP($JOB,LIST,+PSS(1),"SYN",PSS501,403)=$PIECE(PSS501ND,"^",7)
End DoDot:3
End DoDot:2
End DoDot:1
+11 SET ^TMP($JOB,LIST,+PSS(1),"SYN",0)=$SELECT(PSS501C:PSS501C,1:"-1^NO DATA FOUND")
+12 QUIT
+13 ;
SETFMA ;
+1 NEW PSS65C
SET PSS65C=0
+2 IF $ORDER(^PSDRUG(PSS(1),65,0))
NEW PSS65,PSS65ND
Begin DoDot:1
+3 FOR PSS65=0:0
SET PSS65=$ORDER(^PSDRUG(PSS(1),65,PSS65))
if 'PSS65
QUIT
Begin DoDot:2
+4 SET PSS65ND=$GET(^PSDRUG(PSS(1),65,PSS65,0))
IF $PIECE(PSS65ND,"^")
SET PSS65C=PSS65C+1
Begin DoDot:3
+5 SET ^TMP($JOB,LIST,+PSS(1),"FRM",PSS65,.01)=$PIECE(PSS65ND,"^")_"^"_$PIECE($GET(^PSDRUG(+$PIECE(PSS65ND,"^"),0)),"^")
End DoDot:3
End DoDot:2
End DoDot:1
+6 SET ^TMP($JOB,LIST,+PSS(1),"FRM",0)=$SELECT(PSS65C:PSS65C,1:"-1^NO DATA FOUND")
+7 QUIT
+8 ;
SETOLD ;
+1 NEW PSS900C
SET PSS900C=0
+2 IF $ORDER(^PSDRUG(PSS(1),900,0))
NEW PSS900,PSS900ND
Begin DoDot:1
+3 FOR PSS900=0:0
SET PSS900=$ORDER(^PSDRUG(PSS(1),900,PSS900))
if 'PSS900
QUIT
Begin DoDot:2
+4 SET PSS900ND=$GET(^PSDRUG(PSS(1),900,PSS900,0))
IF $PIECE(PSS900ND,"^")'=""
SET PSS900C=PSS900C+1
Begin DoDot:3
+5 SET ^TMP($JOB,LIST,+PSS(1),"OLD",PSS900,.01)=$PIECE(PSS900ND,"^")
+6 NEW Y
SET Y=$PIECE(PSS900ND,"^",2)
IF Y
SET ^TMP($JOB,LIST,+PSS(1),"OLD",PSS900,.02)=$GET(Y)
XECUTE ^DD("DD")
SET ^TMP($JOB,LIST,+PSS(1),"OLD",PSS900,.02)=^TMP($JOB,LIST,+PSS(1),"OLD",PSS900,.02)_"^"_$GET(Y)
End DoDot:3
End DoDot:2
End DoDot:1
+7 SET ^TMP($JOB,LIST,+PSS(1),"OLD",0)=$SELECT(PSS900C:PSS900C,1:"-1^NO DATA FOUND")
+8 QUIT
SETSUB1(PSST1) ;Set sub-header nodes if there is data, and sub-header nodes do not exist
+1 NEW PSST2,PSST3,PSST4
+2 IF $GET(^PSDRUG(PSST1,1,0))=""
IF $ORDER(^PSDRUG(PSST1,1,0))
Begin DoDot:1
+3 SET (PSST4,PSST3)=0
FOR PSST2=0:0
SET PSST2=$ORDER(^PSDRUG(PSST1,1,PSST2))
if 'PSST2
QUIT
IF $DATA(^PSDRUG(PSST1,1,PSST2,0))
SET PSST3=PSST2
SET PSST4=PSST4+1
+4 IF PSST4
SET ^PSDRUG(PSST1,1,0)="^50.1A^"_PSST3_"^"_PSST4
End DoDot:1
+5 QUIT
SETSUB2(PSST1) ;
+1 NEW PSST2,PSST3,PSST4
+2 IF $GET(^PSDRUG(PSST1,65,0))=""
IF $ORDER(^PSDRUG(PSST1,65,0))
Begin DoDot:1
+3 SET (PSST4,PSST3)=0
FOR PSST2=0:0
SET PSST2=$ORDER(^PSDRUG(PSST1,65,PSST2))
if 'PSST2
QUIT
IF $DATA(^PSDRUG(PSST1,65,PSST2,0))
SET PSST3=PSST2
SET PSST4=PSST4+1
+4 IF PSST4
SET ^PSDRUG(PSST1,65,0)="^50.065P^"_PSST3_"^"_PSST4
End DoDot:1
+5 QUIT
SETSUB3(PSST1) ;
+1 NEW PSST2,PSST3,PSST4
+2 IF $GET(^PSDRUG(PSST1,900,0))=""
IF $ORDER(^PSDRUG(PSST1,900,0))
Begin DoDot:1
+3 SET (PSST4,PSST3)=0
FOR PSST2=0:0
SET PSST2=$ORDER(^PSDRUG(PSST1,900,PSST2))
if 'PSST2
QUIT
IF $DATA(^PSDRUG(PSST1,900,PSST2,0))
SET PSST3=PSST2
SET PSST4=PSST4+1
+4 IF PSST4
SET ^PSDRUG(PSST1,900,0)="^50.01A^"_PSST3_"^"_PSST4
End DoDot:1
+5 QUIT
SETSUB4(PSST1) ;
+1 NEW PSST2,PSST3,PSST4
+2 IF $GET(^PSDRUG(PSST1,441,0))=""
IF $ORDER(^PSDRUG(PSST1,441,0))
Begin DoDot:1
+3 SET (PSST4,PSST3)=0
FOR PSST2=0:0
SET PSST2=$ORDER(^PSDRUG(PSST1,441,PSST2))
if 'PSST2
QUIT
IF $DATA(^PSDRUG(PSST1,441,PSST2,0))
SET PSST3=PSST2
SET PSST4=PSST4+1
+4 IF PSST4
SET ^PSDRUG(PSST1,441,0)="^50.0441P^"_PSST3_"^"_PSST4
End DoDot:1
+5 QUIT
SETSUB5(PSST1) ;
+1 NEW PSST2,PSST3,PSST4
+2 IF $GET(^PSDRUG(PSST1,4,0))=""
IF $ORDER(^PSDRUG(PSST1,4,0))
Begin DoDot:1
+3 SET (PSST4,PSST3)=0
FOR PSST2=0:0
SET PSST2=$ORDER(^PSDRUG(PSST1,4,PSST2))
if 'PSST2
QUIT
IF $DATA(^PSDRUG(PSST1,4,PSST2,0))
SET PSST3=PSST2
SET PSST4=PSST4+1
+4 IF PSST4
SET ^PSDRUG(PSST1,4,0)="^50.0214DA^"_PSST3_"^"_PSST4
End DoDot:1
+5 QUIT
SETSUB6(PSST1) ;
+1 NEW PSST2,PSST3,PSST4
+2 IF $GET(^PSDRUG(PSST1,"CLOZ2",0))=""
IF $ORDER(^PSDRUG(PSST1,"CLOZ2",0))
Begin DoDot:1
+3 SET (PSST4,PSST3)=0
FOR PSST2=0:0
SET PSST2=$ORDER(^PSDRUG(PSST1,"CLOZ2",PSST2))
if 'PSST2
QUIT
IF $DATA(^PSDRUG(PSST1,"CLOZ2",PSST2,0))
SET PSST3=PSST2
SET PSST4=PSST4+1
+4 IF PSST4
SET ^PSDRUG(PSST1,"CLOZ2",0)="^50.02P^"_PSST3_"^"_PSST4
End DoDot:1
+5 QUIT
SETSUB7(PSST1) ;
+1 NEW PSST2,PSST3,PSST4
+2 IF $GET(^PSDRUG(PSST1,"DOS1",0))=""
IF $ORDER(^PSDRUG(PSST1,"DOS1",0))
Begin DoDot:1
+3 SET (PSST4,PSST3)=0
FOR PSST2=0:0
SET PSST2=$ORDER(^PSDRUG(PSST1,"DOS1",PSST2))
if 'PSST2
QUIT
IF $DATA(^PSDRUG(PSST1,"DOS1",PSST2,0))
SET PSST3=PSST2
SET PSST4=PSST4+1
+4 IF PSST4
SET ^PSDRUG(PSST1,"DOS1",0)="^50.0903^"_PSST3_"^"_PSST4
End DoDot:1
+5 QUIT
SETSUB8(PSST1) ;
+1 NEW PSST2,PSST3,PSST4
+2 IF $GET(^PSDRUG(PSST1,"DOS2",0))=""
IF $ORDER(^PSDRUG(PSST1,"DOS2",0))
Begin DoDot:1
+3 SET (PSST4,PSST3)=0
FOR PSST2=0:0
SET PSST2=$ORDER(^PSDRUG(PSST1,"DOS2",PSST2))
if 'PSST2
QUIT
IF $DATA(^PSDRUG(PSST1,"DOS2",PSST2,0))
SET PSST3=PSST2
SET PSST4=PSST4+1
+4 IF PSST4
SET ^PSDRUG(PSST1,"DOS2",0)="^50.0904^"_PSST3_"^"_PSST4
End DoDot:1
+5 QUIT
SETSUB9(PSST1) ;
+1 NEW PSST2,PSST3,PSST4
+2 IF $GET(^PSDRUG(PSST1,212,0))=""
IF $ORDER(^PSDRUG(PSST1,212,0))
Begin DoDot:1
+3 SET (PSST4,PSST3)=0
FOR PSST2=0:0
SET PSST2=$ORDER(^PSDRUG(PSST1,212,PSST2))
if 'PSST2
QUIT
IF $DATA(^PSDRUG(PSST1,212,PSST2,0))
SET PSST3=PSST2
SET PSST4=PSST4+1
+4 IF PSST4
SET ^PSDRUG(PSST1,212,0)="^50.0212P^"_PSST3_"^"_PSST4
End DoDot:1
+5 QUIT
SETDF(PSSIEN) ;
+1 ;PSSIEN - IEN of entry in PHARMACY ORDERABLE ITEM file (#50.7).
+2 ;Returns NAME field (#.01) of PHARMACY ORDERABLE ITEM file (#50.7) and DOSAGE FORM
+3 NEW DIERR,ZZERR,PSS50P7,PSS
+4 IF +$GET(PSSIEN)'>0
QUIT -1_"^"_"NO DATA FOUND"
+5 DO GETS^DIQ(50.7,+PSSIEN,".01;.02","IE","PSS50P7")
+6 IF '$DATA(PSS50P7)
QUIT -1_"^"_"NO DATA FOUND"
+7 QUIT $GET(PSSIEN)_"^"_$GET(PSS50P7(50.7,PSSIEN_",",.01,"I"))_"^"_$GET(PSS50P7(50.7,PSSIEN_",",.02,"I"))_"^"_$GET(PSS50P7(50.7,PSSIEN_",",.02,"E"))
