- 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 Jan 18, 2025@03:30:23 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"))