- PSS51P1C ;BIR/LDT - API FOR INFORMATION FROM FILE 51.1; 5 Sep 03
- ;;1.0;PHARMACY DATA MANAGEMENT;**85**;9/30/97
- ;
- ALL ;
- I +$G(PSSIEN)>0 N PSSIEN2 S PSSIEN2=$$FIND1^DIC(51.1,"","A","`"_PSSIEN,,,"") D
- .I +PSSIEN2'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
- .S ^TMP($J,LIST,0)=1
- .D GETS^DIQ(51.1,+PSSIEN2,".01;1;2;4;5;6;2.5;8;8.1;3*;7*","IE","^TMP(""PSS51P1"",$J)") S PSS(1)=0
- .F S PSS(1)=$O(^TMP("PSS51P1",$J,51.1,PSS(1))) Q:'PSS(1) D SETZRO
- .S (CNT2,PSS(2))=0 F S PSS(2)=$O(^TMP("PSS51P1",$J,51.11,PSS(2))) Q:'PSS(2) D SETWARD S CNT2=CNT2+1
- .S ^TMP($J,LIST,+PSSIEN,"WARD",0)=$S(CNT2>0:CNT2,1:"-1^NO DATA FOUND")
- .S (CNT3,PSS(3))=0 F S PSS(3)=$O(^TMP("PSS51P1",$J,51.17,PSS(3))) Q:'PSS(3) D SETLOC S CNT3=CNT3+1
- .S ^TMP($J,LIST,+PSSIEN,"HOSP",0)=$S(CNT3>0:CNT3,1:"-1^NO DATA FOUND")
- I +$G(PSSIEN)'>0,$G(PSSFT)]"" D
- .I PSSFT["??" D LOOP(1) Q
- .D FIND^DIC(51.1,,"@;.01;1","QP",PSSFT,,"B",,,"")
- .I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
- .I +^TMP("DILIST",$J,0)>0 S ^TMP($J,LIST,0)=+^TMP("DILIST",$J,0) N PSSXX S PSSXX=0 F S PSSXX=$O(^TMP("DILIST",$J,PSSXX)) Q:'PSSXX D
- ..S PSSIEN=+^TMP("DILIST",$J,PSSXX,0) K ^TMP("PSS51P1",$J) D GETS^DIQ(51.1,+PSSIEN,".01;1;2;4;5;6;2.5;8;8.1;3*;7*","IE","^TMP(""PSS51P1"",$J)") S PSS(1)=0
- ..F S PSS(1)=$O(^TMP("PSS51P1",$J,51.1,PSS(1))) Q:'PSS(1) D SETZRO
- ..S (CNT2,PSS(2))=0 F S PSS(2)=$O(^TMP("PSS51P1",$J,51.11,PSS(2))) Q:'PSS(2) D SETWARD S CNT2=CNT2+1
- ..S ^TMP($J,LIST,+PSSIEN,"WARD",0)=$S(CNT2>0:CNT2,1:"-1^NO DATA FOUND")
- ..S (CNT3,PSS(3))=0 F S PSS(3)=$O(^TMP("PSS51P1",$J,51.17,PSS(3))) Q:'PSS(3) D SETLOC S CNT3=CNT3+1
- ..S ^TMP($J,LIST,+PSSIEN,"HOSP",0)=$S(CNT3>0:CNT3,1:"-1^NO DATA FOUND")
- K ^TMP("DILIST",$J),^TMP("PSS51P1",$J)
- Q
- ;
- SETZRO ;
- S ^TMP($J,LIST,+PSS(1),.01)=$G(^TMP("PSS51P1",$J,51.1,PSS(1),.01,"I"))
- S ^TMP($J,LIST,"B",$G(^TMP("PSS51P1",$J,51.1,PSS(1),.01,"I")),+PSS(1))=""
- S ^TMP($J,LIST,+PSS(1),1)=$G(^TMP("PSS51P1",$J,51.1,PSS(1),1,"I"))
- S ^TMP($J,LIST,+PSS(1),2)=$G(^TMP("PSS51P1",$J,51.1,PSS(1),2,"I"))
- S ^TMP($J,LIST,+PSS(1),4)=$G(^TMP("PSS51P1",$J,51.1,PSS(1),4,"I"))
- S ^TMP($J,LIST,+PSS(1),5)=$S($G(^TMP("PSS51P1",$J,51.1,PSS(1),5,"I"))="":"",1:^TMP("PSS51P1",$J,51.1,PSS(1),5,"I")_"^"_^TMP("PSS51P1",$J,51.1,PSS(1),5,"E"))
- S ^TMP($J,LIST,+PSS(1),6)=$G(^TMP("PSS51P1",$J,51.1,PSS(1),6,"I"))
- S ^TMP($J,LIST,+PSS(1),2.5)=$G(^TMP("PSS51P1",$J,51.1,PSS(1),2.5,"I"))
- S ^TMP($J,LIST,+PSS(1),8)=$G(^TMP("PSS51P1",$J,51.1,PSS(1),8,"I"))
- S ^TMP($J,LIST,+PSS(1),8.1)=$G(^TMP("PSS51P1",$J,51.1,PSS(1),8.1,"I"))
- Q
- ;
- SETWARD ;
- S ^TMP($J,LIST,+PSSIEN,"WARD",+PSS(2),.01)=$S($G(^TMP("PSS51P1",$J,51.11,PSS(2),.01,"I"))="":"",1:^TMP("PSS51P1",$J,51.11,PSS(2),.01,"I")_"^"_^TMP("PSS51P1",$J,51.11,PSS(2),.01,"E"))
- S ^TMP($J,LIST,+PSSIEN,"WARD",+PSS(2),1)=$G(^TMP("PSS51P1",$J,51.11,PSS(2),1,"I"))
- Q
- ;
- SETLOC ;
- S ^TMP($J,LIST,+PSSIEN,"HOSP",+PSS(3),.01)=$S($G(^TMP("PSS51P1",$J,51.17,PSS(3),.01,"I"))="":"",1:^TMP("PSS51P1",$J,51.17,PSS(3),.01,"I")_"^"_^TMP("PSS51P1",$J,51.17,PSS(3),.01,"E"))
- S ^TMP($J,LIST,+PSSIEN,"HOSP",+PSS(3),1)=$G(^TMP("PSS51P1",$J,51.17,PSS(3),1,"I"))
- S ^TMP($J,LIST,+PSSIEN,"HOSP",+PSS(3),2)=$G(^TMP("PSS51P1",$J,51.17,PSS(3),2,"I"))
- Q
- ;
- LOOP(PSSLP) ;
- N CNT,CNT2,CNT3,PSSIEN S (CNT,PSSIEN)=0
- F S PSSIEN=$O(^PS(51.1,PSSIEN)) Q:'PSSIEN D @(PSSLP) S CNT=CNT+1
- S ^TMP($J,LIST,0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND")
- K ^TMP("DILIST",$J),^TMP("PSS51P1",$J)
- Q
- 1 ;
- K ^TMP("PSS51P1",$J) D GETS^DIQ(51.1,+PSSIEN,".01;1;2;4;5;6;2.5;8;8.1;3*;7*","IE","^TMP(""PSS51P1"",$J)") S PSS(1)=0
- F S PSS(1)=$O(^TMP("PSS51P1",$J,51.1,PSS(1))) Q:'PSS(1) D SETZRO
- S (CNT2,PSS(2))=0 F S PSS(2)=$O(^TMP("PSS51P1",$J,51.11,PSS(2))) Q:'PSS(2) D SETWARD S CNT2=CNT2+1
- S ^TMP($J,LIST,+PSSIEN,"WARD",0)=$S(CNT2>0:CNT2,1:"-1^NO DATA FOUND")
- S (CNT3,PSS(3))=0 F S PSS(3)=$O(^TMP("PSS51P1",$J,51.17,PSS(3))) Q:'PSS(3) D SETLOC S CNT3=CNT3+1
- S ^TMP($J,LIST,+PSSIEN,"HOSP",0)=$S(CNT3>0:CNT3,1:"-1^NO DATA FOUND")
- Q
- ;
- WARD ;
- I +$G(PSSIEN2)>0,+$G(PSSIEN)>0 D GETS^DIQ(51.11,+PSSIEN2_","_+PSSIEN,".01;1","IE","^TMP($J,""PSS51P1""") D
- .D GETS^DIQ(51.1,+PSSIEN,".01","IE","^TMP($J,""PSS51P1""") S PSS(1)=0 F S PSS(1)=$O(^TMP($J,"PSS51P1",51.1,PSS(1))) Q:'PSS(1) D
- ..S ^TMP($J,LIST,+PSS(1),.01)=$G(^TMP($J,"PSS51P1",51.1,PSS(1),.01,"I"))
- ..S ^TMP($J,LIST,"B",$G(^TMP($J,"PSS51P1",51.1,PSS(1),.01,"E")),+PSS(1))=""
- .S PSS(1)=+PSSIEN,PSS(2)=0 F S PSS(2)=$O(^TMP($J,"PSS51P1",51.11,PSS(2))) Q:'PSS(2) D SETWARD^PSS51P1B S CNT=CNT+1
- .S ^TMP($J,LIST,+PSSIEN,"WARD",0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND FOR PSSIEN2 #"_PSSIEN2)
- .S ^TMP($J,LIST,0)=$S($G(^TMP($J,LIST,+PSSIEN,.01))]"":1,1:"-1^NO DATA FOUND")
- I +$G(PSSIEN)>0,+$G(PSSIEN2)'>0 N PSSIEN3 S PSSIEN3=$$FIND1^DIC(51.1,"","A","`"_PSSIEN,,,"") D
- .I +PSSIEN3'>0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
- .S ^TMP($J,LIST,0)=1
- .D GETS^DIQ(51.1,+PSSIEN3,".01;3*","IE","^TMP($J,""PSS51P1""") S PSS(1)=0 D
- ..F S PSS(1)=$O(^TMP($J,"PSS51P1",51.1,PSS(1))) Q:'PSS(1) S ^TMP($J,LIST,+PSS(1),.01)=^TMP($J,"PSS51P1",51.1,PSS(1),.01,"I") D
- ...S ^TMP($J,LIST,"B",$G(^TMP($J,"PSS51P1",51.1,PSS(1),.01,"E")),+PSS(1))="" S PSS(2)=0
- ...F S PSS(2)=$O(^TMP($J,"PSS51P1",51.11,PSS(2))) Q:'PSS(2) D SETWARD^PSS51P1B S CNT=CNT+1
- ..S ^TMP($J,LIST,+PSSIEN3,"WARD",0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND")
- I +$G(PSSIEN)'>0,$G(PSSFT)]"" D
- .I PSSFT["??" D LOOP^PSS51P1B(2) Q
- .D FIND^DIC(51.1,,"@;.01","QP",PSSFT,,"B",,,"")
- .I +$G(^TMP("DILIST",$J,0))=0 S ^TMP($J,LIST,0)=-1_"^"_"NO DATA FOUND" Q
- .I +^TMP("DILIST",$J,0)>0 S ^TMP($J,LIST,0)=+^TMP("DILIST",$J,0)
- .I +$G(PSSIEN2)'>0 N PSSXX S PSSXX=0 F S PSSXX=$O(^TMP("DILIST",$J,PSSXX)) Q:'PSSXX D
- ..S PSSIEN=+^TMP("DILIST",$J,PSSXX,0) K ^TMP($J,"PSS51P1") D GETS^DIQ(51.1,+PSSIEN,".01;3*","IE","^TMP($J,""PSS51P1""") S (PSS(1),CNT)=0 D
- ...F S PSS(1)=$O(^TMP($J,"PSS51P1",51.1,PSS(1))) Q:'PSS(1) D
- ....S ^TMP($J,LIST,+PSS(1),.01)=$G(^TMP($J,"PSS51P1",51.1,PSS(1),.01,"I"))
- ....S ^TMP($J,LIST,"B",$G(^TMP($J,"PSS51P1",51.1,PSS(1),.01,"E")),+PSS(1))="" S (PSS(2),CNT)=0 D
- .....F S PSS(2)=$O(^TMP($J,"PSS51P1",51.11,PSS(2))) Q:'PSS(2) D SETWARD^PSS51P1B S CNT=CNT+1
- .....S ^TMP($J,LIST,+PSS(1),"WARD",0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND")
- .I +$G(PSSIEN2)>0 N PSSXX S PSSXX=0 F S PSSXX=$O(^TMP("DILIST",$J,PSSXX)) Q:'PSSXX D
- ..S PSSIEN=+^TMP("DILIST",$J,PSSXX,0) K ^TMP($J,"PSS51P1") D GETS^DIQ(51.1,+PSSIEN,".01","IE","^TMP($J,""PSS51P1""")
- ..S PSS(3)=0 F S PSS(3)=$O(^TMP($J,"PSS51P1",51.1,PSS(3))) Q:'PSS(3) D
- ...S ^TMP($J,LIST,+PSS(3),.01)=$G(^TMP($J,"PSS51P1",51.1,PSS(3),.01,"I"))
- ...S ^TMP($J,LIST,"B",$G(^TMP($J,"PSS51P1",51.1,PSS(3),.01,"E")),+PSS(3))=""
- ...D GETS^DIQ(51.11,+PSSIEN2_","_+PSSIEN,".01;1","IE","^TMP($J,""PSS51P1""")
- ...S PSS(1)=+PSSIEN,(PSS(2),CNT)=0 F S PSS(2)=$O(^TMP($J,"PSS51P1",51.11,PSS(2))) Q:'PSS(2) D SETWARD^PSS51P1B S CNT=CNT+1
- ...S ^TMP($J,LIST,+PSSIEN,"WARD",0)=$S(CNT>0:CNT,1:"-1^NO DATA FOUND FOR PSSIEN2 #"_PSSIEN2)
- K ^TMP("DILIST",$J),^TMP($J,"PSS51P1")
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSS51P1C 7059 printed Mar 13, 2025@21:34:36 Page 2
- PSS51P1C ;BIR/LDT - API FOR INFORMATION FROM FILE 51.1; 5 Sep 03
- +1 ;;1.0;PHARMACY DATA MANAGEMENT;**85**;9/30/97
- +2 ;
- ALL ;
- +1 IF +$GET(PSSIEN)>0
- NEW PSSIEN2
- SET PSSIEN2=$$FIND1^DIC(51.1,"","A","`"_PSSIEN,,,"")
- Begin DoDot:1
- +2 IF +PSSIEN2'>0
- SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
- QUIT
- +3 SET ^TMP($JOB,LIST,0)=1
- +4 DO GETS^DIQ(51.1,+PSSIEN2,".01;1;2;4;5;6;2.5;8;8.1;3*;7*","IE","^TMP(""PSS51P1"",$J)")
- SET PSS(1)=0
- +5 FOR
- SET PSS(1)=$ORDER(^TMP("PSS51P1",$JOB,51.1,PSS(1)))
- if 'PSS(1)
- QUIT
- DO SETZRO
- +6 SET (CNT2,PSS(2))=0
- FOR
- SET PSS(2)=$ORDER(^TMP("PSS51P1",$JOB,51.11,PSS(2)))
- if 'PSS(2)
- QUIT
- DO SETWARD
- SET CNT2=CNT2+1
- +7 SET ^TMP($JOB,LIST,+PSSIEN,"WARD",0)=$SELECT(CNT2>0:CNT2,1:"-1^NO DATA FOUND")
- +8 SET (CNT3,PSS(3))=0
- FOR
- SET PSS(3)=$ORDER(^TMP("PSS51P1",$JOB,51.17,PSS(3)))
- if 'PSS(3)
- QUIT
- DO SETLOC
- SET CNT3=CNT3+1
- +9 SET ^TMP($JOB,LIST,+PSSIEN,"HOSP",0)=$SELECT(CNT3>0:CNT3,1:"-1^NO DATA FOUND")
- End DoDot:1
- +10 IF +$GET(PSSIEN)'>0
- IF $GET(PSSFT)]""
- Begin DoDot:1
- +11 IF PSSFT["??"
- DO LOOP(1)
- QUIT
- +12 DO FIND^DIC(51.1,,"@;.01;1","QP",PSSFT,,"B",,,"")
- +13 IF +$GET(^TMP("DILIST",$JOB,0))=0
- SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
- QUIT
- +14 IF +^TMP("DILIST",$JOB,0)>0
- SET ^TMP($JOB,LIST,0)=+^TMP("DILIST",$JOB,0)
- NEW PSSXX
- SET PSSXX=0
- FOR
- SET PSSXX=$ORDER(^TMP("DILIST",$JOB,PSSXX))
- if 'PSSXX
- QUIT
- Begin DoDot:2
- +15 SET PSSIEN=+^TMP("DILIST",$JOB,PSSXX,0)
- KILL ^TMP("PSS51P1",$JOB)
- DO GETS^DIQ(51.1,+PSSIEN,".01;1;2;4;5;6;2.5;8;8.1;3*;7*","IE","^TMP(""PSS51P1"",$J)")
- SET PSS(1)=0
- +16 FOR
- SET PSS(1)=$ORDER(^TMP("PSS51P1",$JOB,51.1,PSS(1)))
- if 'PSS(1)
- QUIT
- DO SETZRO
- +17 SET (CNT2,PSS(2))=0
- FOR
- SET PSS(2)=$ORDER(^TMP("PSS51P1",$JOB,51.11,PSS(2)))
- if 'PSS(2)
- QUIT
- DO SETWARD
- SET CNT2=CNT2+1
- +18 SET ^TMP($JOB,LIST,+PSSIEN,"WARD",0)=$SELECT(CNT2>0:CNT2,1:"-1^NO DATA FOUND")
- +19 SET (CNT3,PSS(3))=0
- FOR
- SET PSS(3)=$ORDER(^TMP("PSS51P1",$JOB,51.17,PSS(3)))
- if 'PSS(3)
- QUIT
- DO SETLOC
- SET CNT3=CNT3+1
- +20 SET ^TMP($JOB,LIST,+PSSIEN,"HOSP",0)=$SELECT(CNT3>0:CNT3,1:"-1^NO DATA FOUND")
- End DoDot:2
- End DoDot:1
- +21 KILL ^TMP("DILIST",$JOB),^TMP("PSS51P1",$JOB)
- +22 QUIT
- +23 ;
- SETZRO ;
- +1 SET ^TMP($JOB,LIST,+PSS(1),.01)=$GET(^TMP("PSS51P1",$JOB,51.1,PSS(1),.01,"I"))
- +2 SET ^TMP($JOB,LIST,"B",$GET(^TMP("PSS51P1",$JOB,51.1,PSS(1),.01,"I")),+PSS(1))=""
- +3 SET ^TMP($JOB,LIST,+PSS(1),1)=$GET(^TMP("PSS51P1",$JOB,51.1,PSS(1),1,"I"))
- +4 SET ^TMP($JOB,LIST,+PSS(1),2)=$GET(^TMP("PSS51P1",$JOB,51.1,PSS(1),2,"I"))
- +5 SET ^TMP($JOB,LIST,+PSS(1),4)=$GET(^TMP("PSS51P1",$JOB,51.1,PSS(1),4,"I"))
- +6 SET ^TMP($JOB,LIST,+PSS(1),5)=$SELECT($GET(^TMP("PSS51P1",$JOB,51.1,PSS(1),5,"I"))="":"",1:^TMP("PSS51P1",$JOB,51.1,PSS(1),5,"I")_"^"_^TMP("PSS51P1",$JOB,51.1,PSS(1),5,"E"))
- +7 SET ^TMP($JOB,LIST,+PSS(1),6)=$GET(^TMP("PSS51P1",$JOB,51.1,PSS(1),6,"I"))
- +8 SET ^TMP($JOB,LIST,+PSS(1),2.5)=$GET(^TMP("PSS51P1",$JOB,51.1,PSS(1),2.5,"I"))
- +9 SET ^TMP($JOB,LIST,+PSS(1),8)=$GET(^TMP("PSS51P1",$JOB,51.1,PSS(1),8,"I"))
- +10 SET ^TMP($JOB,LIST,+PSS(1),8.1)=$GET(^TMP("PSS51P1",$JOB,51.1,PSS(1),8.1,"I"))
- +11 QUIT
- +12 ;
- SETWARD ;
- +1 SET ^TMP($JOB,LIST,+PSSIEN,"WARD",+PSS(2),.01)=$SELECT($GET(^TMP("PSS51P1",$JOB,51.11,PSS(2),.01,"I"))="":"",1:^TMP("PSS51P1",$JOB,51.11,PSS(2),.01,"I")_"^"_^TMP("PSS51P1",$JOB,51.11,PSS(2),.01,"E"))
- +2 SET ^TMP($JOB,LIST,+PSSIEN,"WARD",+PSS(2),1)=$GET(^TMP("PSS51P1",$JOB,51.11,PSS(2),1,"I"))
- +3 QUIT
- +4 ;
- SETLOC ;
- +1 SET ^TMP($JOB,LIST,+PSSIEN,"HOSP",+PSS(3),.01)=$SELECT($GET(^TMP("PSS51P1",$JOB,51.17,PSS(3),.01,"I"))="":"",1:^TMP("PSS51P1",$JOB,51.17,PSS(3),.01,"I")_"^"_^TMP("PSS51P1",$JOB,51.17,PSS(3),.01,"E"))
- +2 SET ^TMP($JOB,LIST,+PSSIEN,"HOSP",+PSS(3),1)=$GET(^TMP("PSS51P1",$JOB,51.17,PSS(3),1,"I"))
- +3 SET ^TMP($JOB,LIST,+PSSIEN,"HOSP",+PSS(3),2)=$GET(^TMP("PSS51P1",$JOB,51.17,PSS(3),2,"I"))
- +4 QUIT
- +5 ;
- LOOP(PSSLP) ;
- +1 NEW CNT,CNT2,CNT3,PSSIEN
- SET (CNT,PSSIEN)=0
- +2 FOR
- SET PSSIEN=$ORDER(^PS(51.1,PSSIEN))
- if 'PSSIEN
- QUIT
- DO @(PSSLP)
- SET CNT=CNT+1
- +3 SET ^TMP($JOB,LIST,0)=$SELECT(CNT>0:CNT,1:"-1^NO DATA FOUND")
- +4 KILL ^TMP("DILIST",$JOB),^TMP("PSS51P1",$JOB)
- +5 QUIT
- 1 ;
- +1 KILL ^TMP("PSS51P1",$JOB)
- DO GETS^DIQ(51.1,+PSSIEN,".01;1;2;4;5;6;2.5;8;8.1;3*;7*","IE","^TMP(""PSS51P1"",$J)")
- SET PSS(1)=0
- +2 FOR
- SET PSS(1)=$ORDER(^TMP("PSS51P1",$JOB,51.1,PSS(1)))
- if 'PSS(1)
- QUIT
- DO SETZRO
- +3 SET (CNT2,PSS(2))=0
- FOR
- SET PSS(2)=$ORDER(^TMP("PSS51P1",$JOB,51.11,PSS(2)))
- if 'PSS(2)
- QUIT
- DO SETWARD
- SET CNT2=CNT2+1
- +4 SET ^TMP($JOB,LIST,+PSSIEN,"WARD",0)=$SELECT(CNT2>0:CNT2,1:"-1^NO DATA FOUND")
- +5 SET (CNT3,PSS(3))=0
- FOR
- SET PSS(3)=$ORDER(^TMP("PSS51P1",$JOB,51.17,PSS(3)))
- if 'PSS(3)
- QUIT
- DO SETLOC
- SET CNT3=CNT3+1
- +6 SET ^TMP($JOB,LIST,+PSSIEN,"HOSP",0)=$SELECT(CNT3>0:CNT3,1:"-1^NO DATA FOUND")
- +7 QUIT
- +8 ;
- WARD ;
- +1 IF +$GET(PSSIEN2)>0
- IF +$GET(PSSIEN)>0
- DO GETS^DIQ(51.11,+PSSIEN2_","_+PSSIEN,".01;1","IE","^TMP($J,""PSS51P1""")
- Begin DoDot:1
- +2 DO GETS^DIQ(51.1,+PSSIEN,".01","IE","^TMP($J,""PSS51P1""")
- SET PSS(1)=0
- FOR
- SET PSS(1)=$ORDER(^TMP($JOB,"PSS51P1",51.1,PSS(1)))
- if 'PSS(1)
- QUIT
- Begin DoDot:2
- +3 SET ^TMP($JOB,LIST,+PSS(1),.01)=$GET(^TMP($JOB,"PSS51P1",51.1,PSS(1),.01,"I"))
- +4 SET ^TMP($JOB,LIST,"B",$GET(^TMP($JOB,"PSS51P1",51.1,PSS(1),.01,"E")),+PSS(1))=""
- End DoDot:2
- +5 SET PSS(1)=+PSSIEN
- SET PSS(2)=0
- FOR
- SET PSS(2)=$ORDER(^TMP($JOB,"PSS51P1",51.11,PSS(2)))
- if 'PSS(2)
- QUIT
- DO SETWARD^PSS51P1B
- SET CNT=CNT+1
- +6 SET ^TMP($JOB,LIST,+PSSIEN,"WARD",0)=$SELECT(CNT>0:CNT,1:"-1^NO DATA FOUND FOR PSSIEN2 #"_PSSIEN2)
- +7 SET ^TMP($JOB,LIST,0)=$SELECT($GET(^TMP($JOB,LIST,+PSSIEN,.01))]"":1,1:"-1^NO DATA FOUND")
- End DoDot:1
- +8 IF +$GET(PSSIEN)>0
- IF +$GET(PSSIEN2)'>0
- NEW PSSIEN3
- SET PSSIEN3=$$FIND1^DIC(51.1,"","A","`"_PSSIEN,,,"")
- Begin DoDot:1
- +9 IF +PSSIEN3'>0
- SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
- QUIT
- +10 SET ^TMP($JOB,LIST,0)=1
- +11 DO GETS^DIQ(51.1,+PSSIEN3,".01;3*","IE","^TMP($J,""PSS51P1""")
- SET PSS(1)=0
- Begin DoDot:2
- +12 FOR
- SET PSS(1)=$ORDER(^TMP($JOB,"PSS51P1",51.1,PSS(1)))
- if 'PSS(1)
- QUIT
- SET ^TMP($JOB,LIST,+PSS(1),.01)=^TMP($JOB,"PSS51P1",51.1,PSS(1),.01,"I")
- Begin DoDot:3
- +13 SET ^TMP($JOB,LIST,"B",$GET(^TMP($JOB,"PSS51P1",51.1,PSS(1),.01,"E")),+PSS(1))=""
- SET PSS(2)=0
- +14 FOR
- SET PSS(2)=$ORDER(^TMP($JOB,"PSS51P1",51.11,PSS(2)))
- if 'PSS(2)
- QUIT
- DO SETWARD^PSS51P1B
- SET CNT=CNT+1
- End DoDot:3
- +15 SET ^TMP($JOB,LIST,+PSSIEN3,"WARD",0)=$SELECT(CNT>0:CNT,1:"-1^NO DATA FOUND")
- End DoDot:2
- End DoDot:1
- +16 IF +$GET(PSSIEN)'>0
- IF $GET(PSSFT)]""
- Begin DoDot:1
- +17 IF PSSFT["??"
- DO LOOP^PSS51P1B(2)
- QUIT
- +18 DO FIND^DIC(51.1,,"@;.01","QP",PSSFT,,"B",,,"")
- +19 IF +$GET(^TMP("DILIST",$JOB,0))=0
- SET ^TMP($JOB,LIST,0)=-1_"^"_"NO DATA FOUND"
- QUIT
- +20 IF +^TMP("DILIST",$JOB,0)>0
- SET ^TMP($JOB,LIST,0)=+^TMP("DILIST",$JOB,0)
- +21 IF +$GET(PSSIEN2)'>0
- NEW PSSXX
- SET PSSXX=0
- FOR
- SET PSSXX=$ORDER(^TMP("DILIST",$JOB,PSSXX))
- if 'PSSXX
- QUIT
- Begin DoDot:2
- +22 SET PSSIEN=+^TMP("DILIST",$JOB,PSSXX,0)
- KILL ^TMP($JOB,"PSS51P1")
- DO GETS^DIQ(51.1,+PSSIEN,".01;3*","IE","^TMP($J,""PSS51P1""")
- SET (PSS(1),CNT)=0
- Begin DoDot:3
- +23 FOR
- SET PSS(1)=$ORDER(^TMP($JOB,"PSS51P1",51.1,PSS(1)))
- if 'PSS(1)
- QUIT
- Begin DoDot:4
- +24 SET ^TMP($JOB,LIST,+PSS(1),.01)=$GET(^TMP($JOB,"PSS51P1",51.1,PSS(1),.01,"I"))
- +25 SET ^TMP($JOB,LIST,"B",$GET(^TMP($JOB,"PSS51P1",51.1,PSS(1),.01,"E")),+PSS(1))=""
- SET (PSS(2),CNT)=0
- Begin DoDot:5
- +26 FOR
- SET PSS(2)=$ORDER(^TMP($JOB,"PSS51P1",51.11,PSS(2)))
- if 'PSS(2)
- QUIT
- DO SETWARD^PSS51P1B
- SET CNT=CNT+1
- +27 SET ^TMP($JOB,LIST,+PSS(1),"WARD",0)=$SELECT(CNT>0:CNT,1:"-1^NO DATA FOUND")
- End DoDot:5
- End DoDot:4
- End DoDot:3
- End DoDot:2
- +28 IF +$GET(PSSIEN2)>0
- NEW PSSXX
- SET PSSXX=0
- FOR
- SET PSSXX=$ORDER(^TMP("DILIST",$JOB,PSSXX))
- if 'PSSXX
- QUIT
- Begin DoDot:2
- +29 SET PSSIEN=+^TMP("DILIST",$JOB,PSSXX,0)
- KILL ^TMP($JOB,"PSS51P1")
- DO GETS^DIQ(51.1,+PSSIEN,".01","IE","^TMP($J,""PSS51P1""")
- +30 SET PSS(3)=0
- FOR
- SET PSS(3)=$ORDER(^TMP($JOB,"PSS51P1",51.1,PSS(3)))
- if 'PSS(3)
- QUIT
- Begin DoDot:3
- +31 SET ^TMP($JOB,LIST,+PSS(3),.01)=$GET(^TMP($JOB,"PSS51P1",51.1,PSS(3),.01,"I"))
- +32 SET ^TMP($JOB,LIST,"B",$GET(^TMP($JOB,"PSS51P1",51.1,PSS(3),.01,"E")),+PSS(3))=""
- +33 DO GETS^DIQ(51.11,+PSSIEN2_","_+PSSIEN,".01;1","IE","^TMP($J,""PSS51P1""")
- +34 SET PSS(1)=+PSSIEN
- SET (PSS(2),CNT)=0
- FOR
- SET PSS(2)=$ORDER(^TMP($JOB,"PSS51P1",51.11,PSS(2)))
- if 'PSS(2)
- QUIT
- DO SETWARD^PSS51P1B
- SET CNT=CNT+1
- +35 SET ^TMP($JOB,LIST,+PSSIEN,"WARD",0)=$SELECT(CNT>0:CNT,1:"-1^NO DATA FOUND FOR PSSIEN2 #"_PSSIEN2)
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +36 KILL ^TMP("DILIST",$JOB),^TMP($JOB,"PSS51P1")
- +37 QUIT
